COMMENT ⊗   VALID 00048 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002
C00006 00003
C00010 00004
C00013 00005
C00016 00006
C00019 00007
C00021 00008
C00023 00009
C00024 00010
C00027 00011
C00029 00012
C00033 00013
C00035 00014
C00038 00015
C00039 00016
C00042 00017
C00044 00018
C00046 00019
C00049 00020
C00052 00021
C00058 00022
C00061 00023
C00063 00024
C00066 00025
C00068 00026
C00071 00027
C00074 00028
C00077 00029
C00080 00030
C00083 00031
C00086 00032
C00089 00033
C00091 00034
C00095 00035
C00099 00036
C00102 00037
C00105 00038
C00107 00039
C00109 00040
C00113 00041
C00117 00042
C00120 00043
C00122 00044
C00125 00045
C00127 00046
C00129 00047
C00131 00048
C00133 ENDMK
C⊗;

;;;   **************************************************************
;;;   ***** MACLISP ****** GARBAGE COLLECTOR AND ALLOCATION STUFF **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1977 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************




	PGBOT GC


SUBTTL	GRABBAGE COLLECTORS AND RELATED ITEMS


GCRET:	TDZA A,A	;GC WITH NORET=NIL
GCNRT:	MOVEI A,TRUTH	;GC WITH NORET=T
	HRRI T,UNBIND	;EXPECTS FLAG IN LH OF T
	PUSH P,T
	JSP T,SPECBIND
	0 A,VNORET
	JRST AGC


GC:	PUSH P,[333333,,FALSE]	;SUBR 0 - USER ENTRY TO GC
	JRST AGC		;TO UNDERSTAND THE 3'S, SEE GSTRT7


MINCEL==6*NFF	;MIN NUMBER WORDS TO RECLAIM FOR EACH SPACE
IFG 40-MINCEL, MINCEL==40

IFN KA10+KI10,[
GCCNT:				;FREELIST COUNTING LOOP TO RUN IN AC'S
OFFSET -.
	NIL			;SO THAT THE FOLLOWING INS WILL STOP ON NIL
GCCNT1:	SKIPE TT,(TT)
GCCNT4:	 AOJA GCCNT0,.-1	;OR MAYBE AOBJN
	JRST GCP4A
LPROG3==:.-1
GCCNT0:
OFFSET 0
.HKILL GCCNT1 GCCNT4 GCCNT0
]		;END OF IFN KA10+KI10
IFN KL10,[
GCCNT1:	SKIPE VGCDAEMON		;FREELIST COUNTING LOOP
	 JRST GCCNT6
	SKIPE TT,(TT)
	 AOBJN GCCNT0,.-1	;SHORT ONE FOR JUST SEEING WHETHER >MINCEL
	JRST GCP4A

GCCNT6:	SKIPE TT,(TT)
	 AOJA GCCNT0,.-1	;LONG ONE FOR COUNTING FOR GCDAEMON
	JRST GCP4A

GCCNT0==:AR1
]		;END OF IFN KL10

;;; *********** GARBAGE COLLECTOR **********

SUBTTL	GC - INITIALIZATION

WHL==:USELESS*QIO*ITS		;FLAG FOR WHO-LINE STUFF

   XCTPRO
AGC4:	HRROS NOQUIT
   NOPRO
	SUBI A,2	;ENTRY FROM FWCONS,FPCONS
	PUSH P,A
   XCTPRO
AGC:	HRROS NOQUIT
   NOPRO
	SKIPE ALGCF	;CANT SUCCESSFULLY GC WHILE IN ALLOC
	 JRST ALERR
AGC1:		;MUST HAVE DONE  HRROS NOQUIT  BEFORE COMING HERE
10%	.SUSET [.RRUNT,,GCTM1]
	MOVEM NACS+1,GCNASV
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,		;GET RUNTIME IN MILLSECS.
10$	MOVEM NACS+1,GCTM1
	MOVE NACS+1,[UUOH,,GCUUSV]
	BLT NACS+1,GCUUSV+LUUSV-1	;SAVE UUOH STUFF, IN CASE STRT IS USED
	MOVE NACS+1,[NACS+2,,GCNASV+1]
	BLT NACS+1,GCNASV+17-<NACS+1>	;SAVE NON-MARKED AC'S
	MOVEI NACS+1,GCACSAV
	BLT NACS+1,GCACSAV+NACS	;BLT AWAY ARG ACS (AND NIL) INTO PROTECTED PLACE
Q$	SETZM GCFXP
	SETZ R,
REPEAT NFF,[
	SKIPN FFS+.RPCNT	;FIGURE OUT WHICH SPACE(S) EMPTY
	 TLO R,400000←-.RPCNT
]		;END OF REPEAT NFF
	SKIPN FFY2		;IF WE RAN OUT OF SYMBOL BLOCKS,
	 TLO R,400000←<-FFY+FFS>	; THEN CREDIT IT TO SYMBOLS
	MOVN D,R		;THIS IS A STANDARD HACK TO KILL ONE BIT
	TDZE R,D		;SKIP IF THERE WERE NO BITS
	 JUMPE R,GCGRAB		;JUMP IF EXACTLY ONE BIT ON
AGC1Q:	SETZM GCRMV
	AOSE IRMVF	;IF OVERRIDE IS ON, THEN
	 SKIPE VGCTWA
	  SETOM GCRMV		;DO REMOVAL ANYHOW.
	MOVNI TT,20		;TOP 40 BITS OF WORD ON
	JSP F,GCINBT		;INIT MARK BITS FOR LIST, FIXNUM, ETC.
	MOVE T,[SFSSIZ,,OFSSIZ]	;SAVE AWAY OLD SIZES OF SPACES
	BLT T,OSASIZ		; (USED FOR ARG TO GC-DAEMON)
	MOVE T,VGCDAEMON
	IOR T,GCGAGV
IFE WHL,	JUMPE T,GCP6
IFN WHL,	JUMPE T,GCP5
KAKI	MOVSI R,GCCNT
KAKI	BLT R,LPROG3
KAKI	SKIPN VGCDAEMON
KAKI	HRLI GCCNT4,(AOBJN GCCNT0,)
	MOVNI R,NFF		;MAY OR MAY NOT HAVE BIGNUMS OR HUNKS
GCP4:	SETZ GCCNT0,
	SKIPGE FFS+NFF(R)
	 JRST GCP4B
	SKIPN VGCDAEMON
	 MOVSI GCCNT0,-MINCEL
	SKIPE TT,FFS+NFF(R)
	 AOJA GCCNT0,GCCNT1
GCP4A:	TLZ GCCNT0,-1
	HRRZ F,GCWORN+NFF(R)	;ACCOUNT FOR LENGTHS OF ITEMS
	IMULI GCCNT0,(F)
	CAIGE GCCNT0,MINCEL	;IF LESS THEN MINCEL, THEN FREELIST WAS
	 SETZM FFS+NFF(R)	; "PRACTICALLY EMPTY" AND DESERVES SOME BLAME
GCP4B:	HRLM GCCNT0,NFFS+NFF(R)
	AOJL R,GCP4

;FALLS THROUGH

;FALLS IN

;;;	PDLS ARE SAFE

IFN WHL,[
GCP5:	MOVE F,GCWHO
	SKIPE GCGAGV
	JRST GSTRT0
	TRNN F,1
	JRST GCP6
	JRST GSTR0A
]		;END OF IFN WHL
IFE WHL,[
	SKIPN GCGAGV
	 JRST GCP6
]		;END OF IFE WHL
GSTRT0:	STRT 17,[SIXBIT \↑M;GC DUE TO !\]
GSTR0A:	SETZB TT,D		;FIGURE OUT REASON FOR GC
	HLRZ T,(P)
	CAIN T,111111		;WAS IT INITIAL STARTUP? (SEE LISP)
	 MOVEI TT,[SIXBIT \STARTUP!\]
	CAIN T,333333		;WAS IT USER CALLING GC FUNCTION?
	 MOVEI TT,[SIXBIT \USER!\]
	CAIN T,444444		;WAS IT ARRAYS?
	 MOVEI TT,[SIXBIT \ARRAY RELOCATION!\]
Q$	CAIN T,555555		;I/O CHANNELS?
Q$	 MOVEI TT,[SIXBIT \I/O CHANNELS!\]
	JUMPN TT,GSTRT8
	MOVNI T,NFF		;NONE OF THOSE HYPOTHESES WORK
GSTRT1:	SKIPN FFS+NFF(T)	;MAYBE SOME STORAGE SPACE RAN OUT
	 SKIPA TT,T
	  ADDI D,1
	AOJL T,GSTRT1
	JUMPE TT,GSTRT7		;NO, THAT WASN'T IT
IFN WHL,	SKIPN GCGAGV
.ALSO,		 JRST GSTRT4
	MOVNI T,NFF		;YES, IT WAS. PRINT MOBY MESSAGE!
	SETZ R,
GSTRT2:	SKIPE FFS+NFF(T)
	 JRST GSTRT5
	JUMPE R,GSTRT3
	CAIE D,NFF-2
	 STRT 17,[SIXBIT \, !\]
	CAMN T,TT
	 STRT 17,[SIXBIT \ AND !\]
GSTRT3:	SETO R,
	STRT 17,@GSTRT9+NFF(T)
GSTRT5:	AOJL T,GSTRT2
	STRT 17,[SIXBIT \ SPACE!\]
	CAIE D,NFF-1
	 STRT 17,[SIXBIT \S!\]
IFN WHL, GSTRT4:	MOVE TT,GSTRT9+NFF(TT)
	JRST GSTRT6


GSTRT7:	MOVEI TT,[SIXBIT \ ? !\]	;I DON'T KNOW WHY WE'RE HERE!
GSTRT8:
IFN WHL,SKIPE GCGAGV
	STRT 17,(TT)		;PRINT REASON

GSTRT6:
IFN WHL,[
	TRNN F,1
	 JRST GCWHL9
	MOVE D,(TT)
	MOVE R,1(TT)
	ROTC D,-22
	MOVSI F,(SIXBIT \!\)
	MOVE T,[220600,,D]
GCWHL2:	ILDB TT,T
	CAIE TT,'!
	 JRST GCWHL2
	DPB NIL,T
GCWHL3:	IDPB NIL,T
	TLNE T,770000
	 JRST GCWHL3
	HRLI D,(SIXBIT \GC:\)
	MOVE T,[-6,,GCWHL6]
	.SUSET T
GCWHL9:
]		;END OF IFN WHL

;FALLS THROUGH

;;;	 PDLS ARE SAFE

SUBTTL	GC - MARK THE WORLD

;FALLS IN

GCP6:	HRROS MUNGP		;STARTING TO MUNG SYMBOL/SAR MARK BITS
	MOVE A,[<-20>←-NUNMRK]	;PRE-PROTECT CERTAIN
	ANDM A,BTBLKS		; RANDOM LIST CELLS
	MOVNI R,NACS+1		;PROTECT CONTENTS OF MARKED ACS
GCP6Q0:	HRRZ A,GCACSAV+NACS+1(R)
	JSP T,GCMARK
	AOJL R,GCP6Q0
	HRRZ R,C2
	ADDI R,1
GCP6Q1:	HRRZ A,(R)		;CAUSES MARKING OF CONTENTS
	JSP T,GCMARK		; OF ACS AT TIME OF GC, AND OF REG PDL
	CAIGE R,(P)
	 AOJA R,GCP6Q1
	MOVEI R,LPROTE-1
GCP6Q2:	MOVEI A,BPROTE(R)	;PROTECT PRECIOUS STUFF
	JSP T,GCMARK
	SOJGE R,GCP6Q2
IFN BIGNUM,[
	MOVEI R,LBIGPRO-1
GCP6Q3:	MOVEI A,BBIGPRO(R)
	JSP T,GCMARK
	SOJGE R,GCP6Q3
]		;END OF IFN BIGNUM
	MOVSI R,TTS<GC>
	IORM R,DEDSAR+TTSAR	;PROTECT DEDSAR
	IORM R,DBM+TTSAR	;PROTECT DEAD BLOCK MARKER
	HRRZ R,SC2
GCP6Q4:	HRRZ A,(R)
	JSP T,GCMARK		;MARK SAVED VALUES ON SPEC PDL
	CAIGE R,(SP)
	 AOJA R,GCP6Q4
	SKIPN R,INTAR
	 JRST GCP6Q6
GCP6Q5:	MOVE A,INTAR(R)
	JSP T,GCMARK
	SOJG R,GCP6Q5
GCP6Q6:				;PROTECT INTERRUPT FUNCTIONS
IFE QIO,[
	MOVEI R,LUINTTB-1
GCP6Q7:	SKIPE A,@UINTTB(R)
	 JSP T,GCMARK
	SOJGE R,GCP6Q7
]		;END OF IFE QIO
IFN QIO,[
IRP Z,,[0,1,2]X,,[ALARMCLOCK,AUTFN,UDF]
	MOVEI R,NUINT!Z
	SKIPE A,V!X(R)
	 JSP T,GCMARK
	SOJG R,.-2
TERMIN
	SKIPE A,VMERR
	 JSP T,GCMARK
]		;END OF IFN QIO
IFN LHFLAG,[
	SKIPN D,LHSGLK		;SKIP IF ANY LH SEGMENTS
	 JRST GCP6R0		.SEE LHVBAR
GCP6Q8:	MOVEI F,(D)		;CREATE AOBJN POINTER INTO SEGMENT
	LSH F,SEGLOG
	HRLI F,-SEGSIZ
GCP6Q9:	HLRZ A,(F)		;MARK FROM ALL ENTRIES IN THAT SEGMENT
	JSP T,GCMARK
	HRRZ A,(F)
	JSP T,GCMARK
	AOBJN F,GCP6Q9
	LDB D,[SEGBYT,,GCST(D)]	;FOLLOW LINKED LIST OF SEGMENTS
	JUMPN D,GCP6Q8
GCP6R0:
]		;END OF IFN LHFLAG

;FALLS THROUGH

;;;	PDLS ARE SAFE

;FALLS IN

	SKIPN GCRMV
	 JRST GCP6B1
	JSP R,GCGEN		;IF DOING TWA REMOVAL, TRY MARKING FROM 
		GCP8I		;NON-TRIVIAL P-LISTS OF CURRENT OBARRAY
	JRST GCP6B2

GCP6B1:	MOVE A,VOBARRAY
	JSP TT,$GCMKAR		;OTHERWISE, JUST MARK OBARRAY BUCKETS
GCP6B2:	MOVEI A,OBARRAY
	CAME A,VOBARRAY
	 JSP TT,$GCMKAR
	MOVE R,GCMKL
GCP6A:	JUMPE R,GCP6D
	HLRZ A,(R)
	MOVE D,ASAR(A)
	TLNN D,AS<GCP>	;IF ARRAY POINTER HAS "GC ME" BIT SET,
	 JRST GCP6F
	TLNE D,AS<OBA>	;MORE CHECKING ON OBARRAYS
	 JRST GCP6F0
GCP6F1:	JSP TT,GCMKAR	; THEN MARK FROM ARRAY ENTRIES
GCP6F:	HRRZ R,(R)
	HRRZ R,(R)
	JRST GCP6A

GCP6F0:	CAMN A,VOBARRAY	; AND IF THIS ISN'T THE CURRENT OBARRAY,
	 SKIPN GCRMV	; OR IT IS, BUT WE ARENT DOING GCTWA REMOVAL,
	  JRST GCP6F1
	JRST GCP6F

GCP6D:
IFN QIO,[
	MOVE A,V%TYI
	JSP TT,$GCMKAR
	MOVE A,V%TYO
	JSP TT,$GCMKAR
]		;END OF IFN QIO
	SKIPN R,PROLIS
GCP6D1:	 JUMPE R,GCP6H	;PROTECT READ-MACRO
	HLRZ A,(R)	; FUNCTIONS (CAN'T JUST GCMARK WHOLE
	HLRZ A,(A)	; PROLIS - DON'T WANT TO PROTECT
	JSP T,GCMARK	; READTABLE SARS)
	HRRZ R,(R)
	JRST GCP6D1


GSTRT9:	[SIXBIT \LIST!\]	.SEE GCWORRY
	[SIXBIT \FIXNUM!\]	.SEE GCPNT
	[SIXBIT \FLONUM!\]
DB$	[SIXBIT \DOUBLE!\]
CX$	[SIXBIT \COMPLEX!\]
DX$	[SIXBIT \DUPLEX!\]
BG$	[SIXBIT \BIGNUM!\]
	[SIXBIT \SYMBOL!\]
IRP X,,[4,8,16,32,64,128,256,512,1024]
IFE .IRPCNT-HNKLOG, .ISTOP
	[SIXBIT \HUNK!X!!\]
TERMIN
	[SIXBIT \ARRAY!\]

IFN WHL,[
GCWHL6:	.RWHO1,,GCWHO1
	.RWHO2,,GCWHO2
	.RWHO3,,GCWHO3
	.SWHO1,,[.BYTE 8 ? 66 ? 0 ? 366 ? 0 ? .BYTE]
	.SWHO2,,D
	.SWHO3,,R
]		;IFN WHL

;;;	PDLS ARE SAFE

SUBTTL	GC - CONSIDER THE EFFECTS OF AN ARRAY DISAPPEARING

;;; UPDATE THE GCMKL BY SPLICING OUT ARRAYS TO BE SWEPT.
;;; IF ANY SUCH ARRAYS ARE OPEN FILES, CLOSE THEM.

CGCMKL:
GCP6H:	SKIPN F,GCMKL
	JRST GCP7
	JSP A,GCP6H0
GCP6H1:	HLRZ A,(F)
	TDNE TT,TTSAR(A)
	JRST GCP6G
Q$	TDNE T,ASAR(A)
Q$	JRST GCP6H7
Q$ GCP6H8:
	ANDCAM TT,TTSAR(A)
	IORM R,TTSAR(A)
	MOVEI B,ADEAD
	EXCH B,ASAR(A)
	TLNN B,AS<RDT>
	JRST GCP6G
	MOVEI AR1,PROLIS	;JUST KILLED A READTABLE
GCP6H3:	HRRZ AR2A,(AR1)		; - CLEAN UP PROLIS
GCP6H4:	JUMPE AR2A,GCP6G
	HLRZ C,(AR2A)
	HRRZ C,(C)
	HLRZ C,(C)
	CAIE C,(A)
	JRST GCP6H5
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)
	JRST GCP6H4
GCP6H5:	MOVEI AR1,(AR2A)
	JRST GCP6H3
GCP6G:	HRRZ F,(F)
	HRRZ F,(F)
	JUMPN F,GCP6H1
	JRST GCP7

GCP6H0:	MOVSI T,AS<JOB+FIL>	;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP
	MOVE R,[TTDEAD]
	MOVSI TT,TTS<CN+GC>
	JRST (A)

;;;	PDLS ARE SAFE


IFN QIO,[

;;; CLEAN UP AND CLOSE A FILE WHEN GARBAGE COLLECTED

GCP6H7:	MOVE B,TTSAR(A)		;ABOUT TO GC A FILE ARRAY
	TLNE B,TTS<CL>		;IGNORE IF ALREADY CLOSED
	 JRST GCP6H8
	PUSH P,F
IFN JOBQIO,[
	HLL B,ASAR(A)
	TLNE B,AS<JOB>
	 JRST GCP6J1
]		;END OF IFN JOBQIO
	PUSHJ P,ICLOSE		;OTHERWISE CLOSE THE FILE
	MOVEI R,[SIXBIT \↑M;FILE CLOSED: !\]
GCP6H2:	SKIPN GCGAGV
	 JRST GCP6H9
	STRT 17,(R)
	HLRZ A,@(P)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	HRROI R,$TYO
	PUSHJ P,PRINTA
GCP6H9:	POP P,F
	JSP A,GCP6H0		;RE-INIT MAGIC CONSTANTS IN ACS
	HLRZ A,(F)
	JRST GCP6H8



IFN JOBQIO,[

;;; CLEAN UP AND CLOSE AN INFERIOR PROCEDURE WHEN GARBAGE COLLECTED

GCP6J1:	MOVEI R,[SIXBIT \↑M;FOREIGN JOB FLUSHED: !\]
	SKIPN T,J.INTB(B)
	 JRST GCP6J3
	MOVEI R,[SIXBIT \↑M;INFERIOR JOB FLUSHED: !\]
	.CALL GCP6J9
	 .VALUE
	.UCLOSE TMPC,
	JFFO T,.+1
	MOVNS TT
	SETZM JOBTB+21(TT)
GCP6J3:	MOVSI T,TTS<CL>
	ANDCAM T,TTSAR(A)
	JRST GCP6H2

GCP6J9:	SETZ
	SIXBIT \OPEN\		;OPEN FILE (INFERIOR PROCEDURE)
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,F.DEV(B)	;DEVICE NAME (USR)
	      ,,F.FN1(B)	;FILE NAME 1 (UNAME)
	400000,,F.FN2(B)	;FILE NAME 2 (JNAME)

]		;END OF IFN JOBQIO

]		;END OF IFN QIO

;;;	PDLS ARE SAFE

SUBTTL	GC - TWA REMOVAL

GCP7:	HRRZ A,GCMKL
	JSP T,GCMARK
	HRRZ A,PROLIS
	JSP T,GCMARK
	SKIPN GCRMV
	JRST GCSWP
	JSP R,GCGEN		;IF DOING TWA REMOVAL, THEN WIPE OUT
	   GCP8G		; T.W.A.'S AND THEN MARK BUCKETS
	MOVE A,VOBARRAY
	JSP TT,$GCMKAR

;FALLS THROUGH

;;;	PDLS ARE UNSAFE

SUBTTL	GC - SWEEP THE WORLD

;FALLS IN

GCSWP:				.SEE KLINIT ;WHICH CLOBBERS NEXT INSTRUCTION
Q$	MOVEM FXP,GCFXP		;WE ARE ABOUT TO CLOBBER THE PDL POINTERS
	MOVNI SP,NFF		;NUMBER OF SPACES TO SWEEP
	MOVEM SP,GC99
;MAJOR SWEEP LOOP OVER ALL SPACES
GCSW1:
IFN KA10+KI10,[
	MOVE FXP,GCSWTB+NFF(SP)	;PUT INNER SWEEP LOOP IN AC'S
	HLLZ FLP,FXP		; AND INITIALIZE COUNT
	BLT FLP,(FXP)
	SETZ FXP,			;FREELIST INITIALLY NIL
]		;END OF IFN KA10+KI10
KL	SETZB A,FXP		;FXP HAS FREELIST, A HAS COUNT
	SKIPN FLP,FSSGLK+NFF(SP)
	 JRST GCSW7
;MINOR SWEEP LOOP OVER ALL SEGMENTS IN A SPACE
GCSW2:	MOVEM FLP,GC98
	JRST @GCSW2A+NFF(SP)	;DISPATCH ON TYPE TO SEPARATE ROUTINES
GCSW2A:	GCSWS			;LIST
	GCSWS			;FIXNUM
	GCSWS			;FLONUM
DB$	GCSWD			;DOUBLE
CX$	GCSWC			;COMPLEX
DX$	GCSWZ			;DUPLEX
BG$	GCSWS			;BIGNUM
	GCSWY			;SYMBOL
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCSWH1		;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCSWH2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GCSWA			;SARS
IFN .-GCSW2A-NFF, WARN [WRONG LENGTH TABLE]

GCSW5:	MOVE SP,GC99
	MOVE FLP,GC98
	LDB FLP,[SEGBYT,,GCST(FLP)]
	JUMPN FLP,GCSW2
GCSW7:
KAKI	HRRZ A,@GCSW7A+NFF(SP)
	HRRM FXP,FFS+NFF(SP)	;SAVE FREELIST - DON'T DISTURB SIGN BIT
	HRRZ B,GCWORN+NFF(SP)
	IMULI A,(B)		;ACCOUNT FOR SIZE OF OBJECTS IN THIS SPACE
	HRRM A,NFFS+NFF(SP)	;SAVE COUNT OF WORDS COLLECTED
	AOSGE SP,GC99
	 JRST GCSW1
	HRRZS MUNGP		;WE HAVE UNDONE MUNGING OF BITS
	MOVSI F,TTS<CN+GC>
	ANDCAM F,DEDSAR		;MUST CLEAR BITS IN DEDSAR
	JSP T,GCACR		;RESTORE ACCUMULATORS
	JRST GCPNT		;NEXT PRINT STATISTICS

IFN KA10+KI10,[
;TABLE OF SWEEPERS FOR RUNNING IN ACS AND THE LAST LOCATIONS TO LOAD THEM INTO
GCSWTB:	GCFSSWP,,LPROG1		;LIST
	GCFSSWP,,LPROG1		;FIXNUMN
	GCFSSWP,,LPROG1		;FLONUM
DB$	GCHSW1,,LPROGH		;DOUBLE
CX$	GCHSW1,,LPROGH		;COMPLEX
DX$	GCHSW1,,LPROGH		;DUPLEX
BG$	GCFSSWP,,LPROG1		;BIGNUM
	GSYMSWP,,LPROG6		;SYMBOL
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCHSW1,,LPROGH	;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCHSW2,,LPROGK	;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSARSWP,,LPROG4		;SARS
IFN .-GCSWTB-NFF, WARN [WRONG LENGTH TABLE]

;TABLE OF AC FOR EACH SWEEPER WHICH HOLDS COUNT OF OBJECTS SWEPT
GCSW7A:	GFSCNT			;LIST
	GFSCNT			;FIXNUM
	GFSCNT			;FLONUM
DB$	GHCNT1			;DOUBLE
CX$	GHCNT1			;COMPLEX
DX$	GHCNT1			;DUPLEX
BG$	GFSCNT			;BIGNUM
	GYCNT			;SYMBOL
REPEAT HNKLOG,[
IFL .RPCNT-4,	GHCNT1		;HUNK OF LESS THAN 40 WORDS
.ELSE		GHCNT2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSCNT			;SARS
IFN .-GCSW7A-NFF, WARN [WRONG LENGTH TABLE]

]		;END OF IFN KA10+KI10

GCSWS:	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG
	HRLI FLP,-40		;40 CELLS PER WORD OF BITS
KAKI	JRST GFSP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCFSSWP:			;SWEEPER FOR LIST, FIXNUM, FLONUM, BIGNUM
KAKI OFFSET -.			;RELOCATED TO ACS FOR KA AND KI
GFSP1:	SKIPN SP,(P)		;GET A WORD OF MARK BITS
	 JRST GFSP5		;IF ALL 40 WORDS MARKED, THIS SAVES TIME
GFSP2:	JUMPGE SP,GFSP4		;JUMP IF SINGLE WORD MARKED
	HRRZM FXP,(FLP)		;ELSE CHAIN INTO FREE LIST
	HRRZI FXP,(FLP)
KAKI GFSCNT:	AOJ .,0			;RH COUNTS RECLAIMED CELLS
KL	ADDI A,1
GFSP4:	ROT SP,1		;ROTATE NEXT MARK BIT UP
	AOBJN FLP,GFSP2		;COUNT OFF 40 WORDS
	TLOA FLP,-40		;RESET 40-WORD COUNT IN AOBJN POINTER
GFSP5:	 ADDI FLP,40		;SKIP OVER 40 WORDS IN SWEEP
	AOBJN P,GFSP1		;<BTBSIZ> BLOCKS OF 40 WORDS
	JRST GCSW5
KAKI LPROG1==:.-1
KAKI OFFSET 0
KAKI .HKILL GFSP1 GFSP2 GFSCNT GFSP4 GFSP5


GCSWY:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ
KL	MOVEI GYSP7,(300,,0)	;3.8=PURE, 3.7=COMPILED CODE REFS
KAKI	JRST GYSP1
KL GYSP7==:0
GSYMSWP:			;SWEEPER FOR SYMBOL SPACE
KAKI OFFSET -.
KAKI GYSP7:	(300,,0)	;3.8=PURE, 3.7=COMPILED CODE REFS (NOTE: TSNE WITH ITSELF ALWAYS SKIPS)
GYSP1:	HLRZ SP,(FLP)
	TRZN SP,1		;IF MARKED,
	 TSNE GYSP7,(SP)	; OR IF PURE OR COMPILED CODE NEEDS IT,
	  JRST GYSP3		; THEN DO NOT SWEEP UP
	JUMPN SP,GYSP5		;IF NON-NIL LEFT HALF, RECLAIM THE SYMBOL BLOCK
GYSP2:	HRRZM FXP,(FLP)		;CHAIN ONTO FREELIST
	HRRZI FXP,(FLP)
GYCNT:
KAKI	AOJ .,0
KL	ADDI A,1		;INCREMENT OBJECT COUNT
GYSP3:	HRLM SP,(FLP)
	AOBJN FLP,GYSP1
	JRST GCSW5
KAKI LPROG6==:.-1
KAKI OFFSET 0
KAKI .HKILL GYSP1 GYSP2 GYSP3 GYSP7 GYCNT

;;; PART OF SYMBOL SWEEPER - RESTORES A SYMBOL BLOCK TO FFY2.
;;; ALSO ATTEMPTS TO RETURN THE VALUE CELL IF IT HAS ONE.

GYSP5:	EXCH SP,FFY2		;RETURN SYMBOL BLOCK TO FREELIST
	EXCH SP,@FFY2
	TLZ SP,-1		;MAYBE TRY TO RETURN A VALUE CELL
	CAIE SP,SUNBOUND
	 JRST GYSP5A
	SETZ SP,
	JRST GYSP2

GYSP5A:	CAIL SP,BXVCSG+NXVCSG*SEGSIZ
	 JRST GYSP5B		;CAN ONLY RETURN CELLS IN VC SPACE
	EXCH SP,FFVC
	MOVEM SP,@FFVC
GYSP5B:	SETZ SP,
	JRST GYSP2

IFN HNKLOG+DBFLAG+CXFLAG,[

GCSWD:
GCSWC:
GCSWZ:
GCSWH1:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
KAKI	HRRI GH1SP4,(P)
KL	MOVEI B,(P)
	SUBI P,1
KAKI	HRRI GH1SP5,(P)
KL	MOVEI C,(P)
	HRRZ P,GCWORN+NFF(SP)
	MOVNI SP,40
	IDIVM SP,P
KAKI	HRRI GH1SP6,(P)		;BITS PER BIT BLOCK WORD
KL	MOVEI AR1,(P)
	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG		;MAKE AOBJN POINTER OVER CELLS
KAKI	HRLI FLP,(GH1SP6)
KL	HRLI FLP,(AR1)
KAKI	JRST GH1SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW1:
KAKI OFFSET -.
GH1SP1:	MOVE SP,(P)
GH1SP2:	JUMPGE SP,GH1SP4
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
IFN KA10+KI10,[
GHCNT1:	AOJ .,0
GH1SP4:	ROT SP,1←HNKLOG
GH1SP5:	ADDI FLP,<1←HNKLOG>-1
	AOBJN FLP,GH1SP2
GH1SP6:	HRLI FLP,<-40>←-HNKLOG
]		;END OF IFN KA10+KI10
IFN KL10,[
	ADDI A,1
GH1SP4:	ROT SP,(B)
	ADDI FLP,(C)
	AOBJN FLP,GH1SP2
	HRLI FLP,(AR1)
]		;END OF IFN KL10
	AOBJN P,GH1SP1
	JRST GCSW5
KAKI LPROGH==:.-1
KAKI OFFSET 0
KAKI .HKILL GH1SP1 GH1SP2 GHCNT1 GH1SP4 GH1SP5 GH1SP6

]		;END OF IFN HNKLOG+DBFLAG+CXFLAG

IFG HNKLOG-4,[
GCSWH2:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
KAKI	HRRI GH2SP5,(P)
KL	MOVEI B,(P)
	SUBI P,1
	LSH P,-5
KAKI	HRRI GH2SP7,(P)		;BITS PER BIT BLOCK WORD
KL	MOVEI AR2A,(P)
	HRRZ P,GCWORN+NFF(SP)
	LSH P,-5
	MOVNI SP,BTBSIZ
	IDIVM SP,P
	HRLI P,(P)		;MAKE AOBJN POINTER OVER WORDS OF BITS
	MOVE SP,GCST(FLP)
	LSH SP,SEGLOG-5
	HRRI P,(SP)
	LSH FLP,SEGLOG		;MAKE POINTER OVER CELLS
KAKI	JRST GH2SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW2:
KAKI OFFSET -.
GH2SP1:	SKIPL (P)		;ONLY THE SIGN BIT OF A MARK WORD IS USED
	 JRST GH2SP5
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
IFN KA10+KI10,[
GHCNT2:	AOJ .,0
GH2SP5:	ADDI FLP,1←HNKLOG
GH2SP7:	ADDI P,<<1←HNKLOG>-1>←-5
]		;END OF IFN KA10+KI10
IFN KL10,[
	ADDI A,1
GH2SP5:	ADDI FLP,(B)
	ADDI P,(AR2A)
]		;END OF IFN KL10
	AOBJN P,GH2SP1
	JRST GCSW5
KAKI LPROGK==:.-1
KAKI OFFSET 0
KAKI .HKILL GH2SP1 GH2SP2 GHCNT2 GH2SP5 GH2SP7

]		;END OF IFG HNKLOG-4

GCSWA:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ/2
KL	MOVSI B,(TTS<CN+GC>,,)
KL	MOVSI C,(TTS<GC>,,)
	JRST GSSP1

GSARSWP:			;SPECIAL SWEEPER FOR SARS
KAKI OFFSET -.
GSSP0:	ADDI FLP,1
GSSP1:
KAKI	TDNN GSSP7,TTSAR(FLP)	;TEST IF SAR MARKED (OR OTHERWISE NEEDED)
KL	TDNN B,TTSAR(FLP)
KAKI	 AOJA GSCNT,GSSP2	;NO, COUNT IT AS SWEPT
KL	 AOJA A,GSSP2
KAKI	ANDCAM GSSP8,TTSAR(FLP)	;YES, TURN OFF MARK BIT
KL	ANDCAM C,TTSAR(FLP)
	AOBJN FLP,GSSP0		; AND TRY NEXT ONE
	JRST GCSW5
GSSP2:	HRRZM FXP,ASAR(FLP)	;CHAIN INTO FREE LIST
	HRRZI FXP,ASAR(FLP)
	AOBJN FLP,GSSP0
	JRST GCSW5
KAKI GSSP7:	TTS<CN+GC>,,
KAKI GSSP8:	TTS<GC>,,
KAKI GSCNT:	0
KAKI LPROG4==:.-1
KAKI OFFSET 0
KAKI .HKILL GSSP0 GSSP1 GSSP2 GSSP7 GSSP8 GSCNT

;;; PDLS ARE SAFE

SUBTTL	GC - MAKE SURE ENOUGH WAS RECLAIMED

GCPNT:	SKIPN GCGAGV
	 JRST GCE0
	SETZM GC99		;GC99 COUNTS ENTRIES PRINTED
	MOVNI F,NFF
GCPNT1:	HRRZ T,NFFS+NFF(F)
	SKIPN TT,SFSSIZ+NFF(F)
	 JRST GCPNT6
	SOSLE GC99
	 JRST GCPNT2
	STRT 17,[SIXBIT \↑M; !\]	;TERPRI-; EVERY THIRD ONE
	MOVEI D,3
	MOVEM D,GC99
GCPNT2:	PUSHJ P,STGPNT
	STRT 17,@GSTRT9+NFF(F)
	CAME F,XC-1			;COMMA AFTER EACH BUT LAST
	 STRT 17,[SIXBIT \, !\]
GCPNT6:	AOJL F,GCPNT1
	STRT [SIXBIT \ WORDS FREE!\]

;FALLS THROUGH

;;;	PDLS ARE SAFE

SUBTTL	GC - CLEANUP AND TERMINATION

;FALLS IN

GCE0:	MOVNI F,NFF
GCE0C0:	MOVE AR2A,MFFS+NFF(F)
	TLNN AR2A,-1
	 JRST GCE0C1
	HRRZ AR1,SFSSIZ+NFF(F)
	FSC AR1,233		;FIXNUM TO FLONUM CONVERSION
	FMPR AR1,AR2A
	MULI AR1,400		;FLONUM TO FIXNUM CONVERSION
	ASH AR2A,-243(AR1)
GCE0C1:	SKIPGE FFS+NFF(F)
	 JRST GCE0C5
	CAIGE AR2A,MINCEL
	 MOVEI AR2A,MINCEL	;MUST SATISFY ABSOLUTE MIN OF<MINCEL> CELLS
GCE0C5:	MOVEM AR2A,ZFFS+NFF(F)
	HRRZ TT,NFFS+NFF(F)
	CAIGE TT,(AR2A)		;ALSO MUST SATISFY USER'S MIN
	 PUSHJ P,GCWORRY		;IF NOT, MUST WORRY ABOUT IT
GCE0C2:	AOJL F,GCE0C0
	MOVEI AR2A,1
	SKIPN FFY2
	 PUSHJ P,GRABWORRY	;REMEMBER, F IS ZERO HERE
	SKIPN FFY2
	 JRST GCLUZ
	MOVNI F,NFF		;IF WE RECLAIMED LESS THAN ABSOLUTE
GCE0C3:	HRRZ TT,NFFS+NFF(F)	; MINIMUM FOR ANY SPACE,
	SKIPGE FFS+NFF(F)
	 JRST GCE0C9
	CAIGE TT,MINCEL		; WE ARE OFFICIALLY DEAD
	 JRST GCLUZ
GCE0C9:	AOJL F,GCE0C3
	SKIPE PANICP
	 JRST GCE0C7
	MOVNI F,NFF	;NOW SEE IF WE EXCEEDED MAXIMUM
GCE0C6:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)
	 JRST GCE0K3
Q$	HRLZ D,GCMES+NFF(F)
Q$	HRRI D,1004		;GC-OVERFLOW
Q%	HRLZ A,GCMES+NFF(F)
Q%	HRRI A,13.		;GC-OVERFLOW
	PUSHJ P,UINT		;NOQUIT SET, SO INTERRUPT GETS STACKED
GCE0K3:	AOJL F,GCE0C6
GCE0C7:	MOVNI F,NFF
GCE0C4:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)	;IF A SPACE LOST TO GC-OVERFLOW,
	 JRST GCE0K2		; DON'T MAKE IT LOSE FOR GC-LOSSAGE TOO
	MOVEM TT,XFFS+NFF(F)	;JUST QUIETLY UPDATE ITS GCMAX
	JRST GCE0K1

GCE0K2:	HRRZ T,NFFS+NFF(F)
	CAMGE T,ZFFS+NFF(F)
	 JRST GCMLOSE
GCE0K1:	AOJL F,GCE0C4
IFE D10,[
	HRRZ TT,NOQUIT
	IOR TT,INHIBIT
	IOR TT,VNORET
	SKIPN TT
	PUSHJ P,RETSP
]		;END OF IFE D10
	SKIPE GCGAGV
	 STRT 17,STRTCR
;FALLS THROUGH

;;; PDLS ARE SAFE

;FALLS IN

	SKIPN VGCDAEMON
	 JRST GCEND
	MOVEI C,NIL		;CONS UP ARG FOR GCDAEMON
	MOVEI D,NFF-1		;WE CHECKED LENGTH OF FREELISTS SO
	SETZ C,			; WE KNOW CONSES WON'T RE-INVOKE GC
GCE0E:	MOVE TT,SFSSIZ(D)	;SIZE OF SPACE AFTER GC
	PUSHJ P,CONS1FX
	MOVE TT,OFSSIZ(D)	;SIZE OF SPACE BEFORE GC
	PUSHJ P,CONSFX
	HRRZ TT,NFFS(D)		;LENGTH OF FREELIST AFTER GC
	CAIN D,FFX-FFS		;ALLOW FOR THE SPACE USED
	 SUBI TT,4*NFF		; TO CONS UP THE GC-DAEMON ARG
	CAIN D,FFS-FFS
	 SUBI TT,6*NFF
	PUSHJ P,CONSFX
	HLRZ TT,NFFS(D)		;LENGTH OF FREELIST BEFORE GC
	PUSHJ P,CONSFX
	HRRZ A,GCMES(D)		;NAME OF SPACE
	PUSHJ P,CONS
	MOVE B,C
	PUSHJ P,CONS
	MOVE C,A
	SOJGE D,GCE0E
	JSR GCRSR		.SEE GCRSR0
IFE QIO,[
	HRLI A,20.		;INT NUMBER OF GC-DAEMON
	PUSH P,A		;FOR GC PROTECTION ONLY
	MOVSS A
	PUSHJ P,UINT
	JRST S1PAJ
]		;END OF IFE QIO
IFN QIO,[
	HRLI A,1003		;GC-DAEMON
	PUSH P,A		;FOR INTERRUPT PROTECTION ONLY
	PUSH FXP,D
	MOVS D,A
	PUSHJ P,UINT
	POP FXP,D
	JRST S1PAJ
]		;END OF IFN QIO

;;; GC MUST EITHER JRST TO GCEND, OR JSR TO GCRSR BEFORE EXITING.
;;; THIS ASSURES THAT GCTIM WILL PROPERLY REFLECT TIME SPENT IN GC.

GCEND:	JSP NACS+1,GCACR
Q$	SETZM GCFXP
10%	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]				;IFN WHL
	MOVE NACS+1,GCNASV
	HRRZS NOQUIT
	JRST CHECKI

;GCRSR:	0
GCRSR0:	HRLM C,NOQUIT		;RESTORE ACS, AND CHECK FOR ANY
	JSP NACS+1,GCACR	;DELAYED INTERRUPTS
Q$	SETZM GCFXP
10%	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]				;IFN WHL
	MOVE NACS+1,GCNASV
	PUSH P,A
	HLRZ A,NOQUIT
	PUSH P,GCRSR
	HRRZS NOQUIT
	JRST CHECKI

;;; ROUTINE TO INIT MARK BITS FOR LIST, FIXNUM, FLONUM, HUNK,
;;; AND BIGNUM SPACES. INIT BITS IN TT, RETURN ADDRESS IN F.

GCINBT:	MOVEM TT,BBITSG
	MOVE AR2A,[BBITSG,,BBITSG+1]
	BLT AR2A,@MAINBITBLT	;BLT OUT MAIN BIT AREA
	MOVE A,BTSGLK		;INITIALIZE ALL BIT BLOCKS
GCINB0:	JUMPE A,(F)
	MOVEI AR2A,(A)
	LSH AR2A,SEGLOG		;GET ADDRESS OF SEGMENT
	HRLI AR2A,(AR2A)
	MOVEM TT,(AR2A)
	AOJ AR2A,
	MOVE T,GCST(A)		;GET END ADDRESS FOR BLT
	LSH T,SEGLOG-5
	TLZ T,-1
	CAIE T,(AR2A)
	 BLT AR2A,-1(T)		;***BLT!***
	LDB A,[SEGBYT,,GCST(A)]
	JRST GCINB0

IFN WHL,[
GCWHR:	TRNN NACS+1,2		;SKIP IF GC STATISTICS DESIRED
	 JRST GCWHR2
	MOVE NACS+2,GCTIM
	IDIVI NACS+2,25000./4	;GC TIME IN FORTIETHS OF A SECOND
	MOVEM NACS+2,GCWHO2
	MOVE NACS+2,GCTIM	;GC TIME
	IMULI NACS+2,100.	; TIMES 100.
	IDIV NACS+2,GC98	; DIVIDED BY TOTAL RUNTIME
	HRLM NACS+2,GCWHO2	; EQUALS GC TIME PERCENTAGE
	TRNE NACS+1,1
	 JRST GCWHR2
	.SUSET [.SWHO2,,GCWHO2]	;JUST SET .WHO2 IF WHO VARS NOT PREVIOUSLY SAVED
GCWHR8:	MOVE NACS+2,GCNASV+1	;RESTORE ACS
	MOVE NACS+3,GCNASV+2
	POPJ P,

GCWHR2:	MOVE NACS+2,[-3,,GCWHR9]	;RESTORE WHO VARS, POSSIBLY WITH
	.SUSET NACS+2			; GC STATISTICS CLOBBERED INTO GCWHO2
	JRST GCWHR8

GCWHR9:	.SWHO1,,GCWHO1
	.SWHO2,,GCWHO2
	.SWHO3,,GCWHO3
]		;IFN WHL

SUBTTL	MISCELLANEOUS GC UTILITY ROUTINES

GCACR:
Q$	SKIPN GCFXP
Q$	 MOVEM FXP,GCFXP
	MOVE NIL,[GCACSAV+1,,1]	;RESTORE ALL ACS EXCEPT NACS+1
	BLT NIL,NACS
	MOVE NIL,[GCNASV+1,,NACS+2]
	BLT NIL,17
	MOVE NIL,GCACSAV
Q$	SETZM GCFXP		.SEE CHNINT	;ETC.
	JRST (NACS+1)


$GCMKAR:	MOVE D,ASAR(A)
GCMKAR:
Q$	MOVE F,TTSAR(A)
	SKIPL D,-1(D)	;MARK FROM ARRAY ENTRIES.
	JRST (TT)
GCMKA1:	HLRZ A,(D)
	JSP T,GCMARK
	HRRZ A,(D)
	JSP T,GCMARK
	AOBJN D,GCMKA1
Q%	JRST (TT)
IFN QIO,[
	JUMPE F,(TT)
	TLNE F,TTS<TY>
	TLNE F,TTS<IO>
	JRST (TT)
	MOVEI D,FB.BUF(F)	;FOR TTY INPUT FILE ARRAYS,
	HRLI D,-NASCII/2	; MUST MARK INTERRUPT FUNCTIONS
	SETZ F,
	JRST GCMKA1
]		;END OF IFN QIO

;;; GCGEN GENERATES NON-NULL BUCKETS OF THE CURRENT OBARRAY
;;; AND APPLIES A GIVEN FUNCTION TO THEM. IT IS CALLED AS
;;;		JSP R,GCGEN
;;;		   FOO
;;; GCGEN WILL EFFECTIVELY DO A  JRST FOO  MANY TIMES,
;;; PASSING SOME NON-NULL OBARRAY BUCKET THROUGH ACCUMULATOR D.
;;; FOO IS EXPECTED TO RETURN BY DOING A  JRST GCP8A.
;;; WHEN DONE, GCGEN RETURNS, SKIPPING OVER THE ADDRESS FOO.

GCGEN:	MOVE F,@VOBARRAY	.SEE ASAR
	MOVE F,-1(F)
	SUB F,R70+1
	TLZ R,400000
GCP8A:	TLCE R,400000
	JRST GCP8A1
	AOBJP F,1(R)	;EXIT
	HLRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A
GCP8A1:	HRRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A


;;; MARK AN S-EXPRESSION GIVEN IN A. TRACES IT COMPLETELY,
;;; MARKING ALL SUBITEMS BY SETTING A MARK BIT TO **ZERO**
;;; FOR LIST, FIXNUM, FLONUM, AND BIGNUM SPACES, AND TO
;;; **ONE** FOR SYMBOLS AND SARS. (THIS SPEEDS UP SWEEPING.)
;;; NEVER MARKS VALUE CELLS!!!! (THEY ARE NEVER SWEPT.)
;;; CALLED BY JSP T,GCMARK WITH OBJECT IN A. USES A,B,C,AR1,AR2A.

GCMARK:	JUMPE A,(T)		;NEEDN'T MARK NIL
	MOVEI AR2A,(P)		;REMEMBER WHERE P IS
GCMRK0:	JRST GCMRK1	.SEE KLINIT

GCMRK3:	TLNN A,GCBSYM		;MAYBE WE FOUND A SYMBOL
	 JRST GCMRK4		;NOPE
	HLRZ AR1,(C)		;YUP
	TROE AR1,1
	 JRST GCMKND
	HRLM AR1,(C)
	PUSH P,(C)		;PUSH PROPERTY LIST
	PUSH P,(AR1)		;PUSH PNAME LIST
	SKIPE ETVCFLSP		;A HAC TO SAVE TIME IF THERE NEVER HAVE BEEN
	 JRST GCMRK6		; VALUE CELLS TAKEN FROM LIST SPACE
	HRRZ A,@-1(AR1)
	JRST GCMRK1		;GO MARK VALUE OF SYMBOL

GCMRK6:	HRRZ A,-1(AR1)
	CAIGE A,EVCSG
	 CAIGE A,BVCSG
	  JRST GCMRK7
	HRRZ A,(A)
	CAIE A,QUNBOUND
	 JRST GCMRK1
	JRST GCMRK8

GCMRK7:	LSH A,-SEGLOG
	SKIPL A,GCST(A)		;SKIP IF VALUE CELL NOT A LIST CELL??
	 JRST GCMKND		;SUNBOUND, FOR EXAMPLE????
	HRRZ A,-1(AR1)		;POINTING TO A VC IN LIST SPACE
	JRST GCMRK1

GCMRK4:	TLNN A,GCBVC		;MAYBE WE FOUND A VALUE CELL
	 JRST GCMRK5		;NOPE
	HRRZ A,(C)		;YUP - MARK ITS CDR (THE VALUE)
	JRST GCMRK1

GCMRK5:	MOVSI AR1,TTS<GC>	;MUST BE AN ARRAY
	IORM AR1,TTSAR(C)	;SET ARRAY MARK BIT TO 1
GCMKND:	CAIN AR2A,(P)		;SKIP IF ANYTHING LEFT ON STACK TO MARK
	 JRST (T)		;ELSE RETURN
GCMRK8:	POP P,A			;GET NEXT ITEM TO MARK
GCMRK1:	HRRZS C,A		;ZERO LEFT HALF OF A, ALSO SAVE IN C
	SETZ B,
	LSHC A,-SEGLOG		;GET PAGE NUMBER OF ITEM (OTHER BITS GO INTO B)
	SKIPL A,GCST(A)		;CHECK GCST ENTRY FOR THAT PAGE
	 JRST GCMKND		;NOT MARKABLE - IGNORE IT
	TLNE A,GCBFOO		;MAYBE IT'S A VALUE CELL OR SYMBOL OR SAR
	 JRST GCMRK3		;IF SO HANDLE IT SPECIALLY
	LSHC A,SEGLOG-5		;THIS GETS ADDRESS OF BIT WORD FOR THIS ITEM
	ROT B,5			;B TELLS US WHICH BIT (40/WD)
	MOVE AR1,(A)		;GET WORD OF MARK BITS
	TDZN AR1,GCBT(B)	;CLEAR THE ONE PARTICULAR BIT
	 JRST GCMKND		;QUIT IF ITEM ALREADY MARKED
	MOVEM AR1,(A)		;ELSE SAVE BACK WORD OF BITS
	JUMPGE A,GCMKND	.SEE GCBCDR	;JUMP UNLESS MUST MARK THROUGH (REMEMBER THE LSHC)
	HRR A,(C)		;GET CDR OF ITEM
	TLNN A,GCBCAR←<SEGLOG-5> ;MAYBE WE ALSO WANT TO MARK THE CAR
	 JRST GCMRK1		;NO - GO MARK CDR
	PUSH P,A		;YES - SAVE CDR ON STACK
	HLR A,(C)		;GET CAR OF ITEM AND GO MARK IT
IFE HNKLOG, 	JRST GCMRK1
IFN HNKLOG,[
	TLNN A,GCBHNK←<SEGLOG-5>
	 JRST GCMRK1		;ORDINARY LIST CELL
	PUSH P,T		;FOR HUNK, SAVE T AND AR2A SO
	HRLM AR2A,(P)		; CAN CALL GCMARK RECURSIVELY
	MOVEI A,(C)
	LSH A,-SEGLOG
	HRRZ A,ST(A)		;GET TYPEP OF HUNK
   2DIF [HRL C,(A)]GCHNLN,QHUNK1	;C NOW HAS AOBJN POINTER
	MOVEI AR2A,(P)		;SET UP AR2A FOR RECURSIVE GCMARK
GCMRK2:	MOVEM C,-1(P)		;SAVE AOBJN POINTER IN SLOT PUSHED FOR CDR
	HLRZ A,(C)
	JUMPE A,GCMK2A
	JSP T,GCMRK1		;MARK ODD HUNK SLOT
	MOVE C,-1(P)
GCMK2A:	HRRZ A,(C)
	JUMPE A,GCMK2B
	JSP T,GCMRK1		;MARK EVEN HUNK SLOT
	MOVE C,-1(P)
GCMK2B:	AOBJN C,GCMRK2
	POP P,T			;RESTORE T AND AR2A
	HLRZ AR2A,T
	SUB P,R70+1		;FLUSH AOBJN POINTER
	JRST GCMKND

GCHNLN:
REPEAT HNKLOG, -<2←.RPCNT>	;LH'S FOR AOBJN POINTERS
]		;END OF IFN HNKLOG

IFN ITS,[ IFE SEGLOG-11,[ IFLE HNKLOG-5,[
;;; MARK ROUTINE FOR USE WITH KL-10 MICROCODE

LSPGCM=070000,,
LSPGCS=071000,,

KLGCVC:	SKIPA A,(A)
	 PUSH P,B
KLGCM1:	LSPGCM A,KLGCM2
KLGCND:	CAIN AR2A,(P)
	 JRST (T)
	POP P,A
	JRST KLGCM1

KLGCM2:	JRST KLGCSY
	JRST KLGCVC
	JRST KLGCSA
REPEAT HNKLOG, JRST CONC KLGH,\.RPCNT+1
REPEAT 8-.+KLGCM2, .VALUE

KLGCSY:	HLRZ AR1,(A)
	TROE AR1,1
	 JRST KLGCND
	HRLM AR1,(A)
	PUSH P,(A)
	PUSH P,(AR1)
	HRRZ A,@-1(AR1)
	JRST KLGCM1

KLGCSA:	MOVSI AR1,TTS<GC>
	IORM AR1,TTSAR(A)
	JRST KLGCND

IFN HNKLOG,[
ZZZ==<1←HNKLOG>-1
REPEAT HNKLOG,[
CONC KLGH,\HNKLOG-.RPCNT,:
REPEAT 1←<HNKLOG-.RPCNT-1>,[
	PUSH P,ZZZ(A)
	HLRZ B,(P)
	PUSH P,B
ZZZ==ZZZ-1
]		;END OF REPEAT 1←<HNKLOG-.RPCNT-1>
]		;END OF REPEAT HNKLOG
IFN ZZZ, WARN [YOU LOSE]
	PUSH P,(A)
	HLRZ A,(A)
	JRST KLGCM1
]		;END OF IFN HNKLOG


KLGCSW:	MOVNI T,3+BIGNUM		;SWEEP
KLGS1:	SETZB C,AR1			;ZERO FREELIST AND COUNT
	SKIPN TT,FSSGLK+3+BIGNUM(T)
	 JRST KLGS1D
KLGS1A:	MOVE B,GCST(TT)
	LSH B,SEGLOG-5
	TLZ B,-1
	MOVEI A,(TT)
	LSH A,SEGLOG
	HRLI A,-SEGSIZ
	LSPGCS A,1
	LDB TT,[SEGBYT,,GCST(TT)]
	JUMPN TT,KLGS1A
KLGS1D:	MOVEM C,FFS+3+BIGNUM(T)
	HRRM AR1,NFFS+3+BIGNUM(T)
	AOJL T,KLGS1
	JRST GCSW4A

]]]		;END OF IFLE HNKLOG-5, IFE SEGLOG-11, IFN ITS

GSGEN:	SKIPN AR2A,GCMKL	;GENERATE TAILS OF GCMKL AND APPLY 
	POPJ P,			;FUN IN AR1 TO THEM
	PUSH P,AR1
	MOVEI AR1,GCMKL
	JRST GGEN1

RTSPC2:	JUMPE A,GGEN2
RTSP2A:	ADD D,TT
GGEN2:	HRRZ AR2A,(AR2A)	;GENERAL LOOP FOR GSGEN
	MOVEI AR1,(AR2A)
	HRRZ AR2A,(AR2A)
GGEN1:	JUMPE AR2A,POP1J	;TAIL OF GCMKL IN AR2A,
	HRRZ A,(AR2A)		;SPACE OCCUPIED IN TT,
	HLRZ A,(A)		;ALIVEP IN A
	MOVE TT,(A)
	HLRZ A,(AR2A)
	HLRZ A,ASAR(A)
	JRST @(P)	;ROUTINE WILL RETURN TO GGEN2


GFSPC:	PUSH FXP,AR1
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	POP FXP,AR1
	ADD D,@VBPORG	;NOW HAS TOTAL AMOUNT FREE IN BPS [COUNTING DEAD BLOCKS]
	ADD D,GAMNT	;NOW DIMINISHED BY REQUESTED AMOUNT
	CAMG D,BPSH
	JRST GRELAR	;IF ENOUGH SPACE, THEN RELOCATE
	JRST (R)

;GTSP5:
;$$	POP FXP,AR1
GTSP5A:	SETZB A,TT		;GIVE OUT NIL AND 0 IF FAIL
	JUMPLE AR1,CZECHI
	PUSHJ P,BPSGC
	JSP R,GFSPC
	SETZ AR1,
	JRST GTSP1B

BPSGC:	MOVEI R,444444		;GC SPECIFICALLY FOR BPS
	HRLM R,(P)
	JRST AGC

;;; SOME ROUTINES FOR USE WITH GSGEN

GCP8K:	HLRZ A,(D)
	JSP T,GCMARK
GCP8J:	HRRZ D,(D)	;MARK ATOMS ON OBLIST
GCP8I:	JUMPE D,GCP8A	;WHICH HAVE NON-TRIVIAL
	MOVE A,D	;P-LIST STRUCTURE.
	JSP T,TWAP
	JRST GCP8J
	JRST GCP8K
	JRST GCP8J

GCP8G:	JUMPE D,GCP8A	;REMOVE T.W.A.'S FROM
	MOVE A,D	;BUCKETS OF OBLIST.
	JSP T,TWAP
	JRST GCP8B
	JRST GCP8B
	HRRZ D,(D)
	TLNE R,400000	;BUCKET COMES FROM LH OF WORD IN OBARRAY
	HRLM D,(F)	;IF AT THIS POINT R < 0
	TLNN R,400000
	HRRM D,(F)
	JSP T,GCP8L
	JRST GCP8G
GCP8C:	HRRZ D,(D)
GCP8B:	HRRZ A,(D)
GCP8D:	JUMPE A,GCP8A
	JSP T,TWAP
	JRST GCP8C
	JRST GCP8C
	HRRZ A,(D)
	HRRZ A,(A)
	HRRM A,(D)
	JSP T,GCP8L
	JRST GCP8B

GCP8H:	MOVE A,D	;MARK OBLIST BUCKET
	JSP T,GCMARK
	JRST GCP8A

GCP8L:	JUMPE TT,(T)	;IF SCO REMOB'D, THEN REMOVE FROM SCO TABLE
	HRRZ A,(TT)
	JUMPN A,(T)
	HLRZ A,(TT)
	MOVE B,(A)	;MUST NOT BE INTERRUPTIBLE HERE
	MOVEI A,0
	LSHC A,7
	JUMPN B,(T)
	HRRZ TT,VOBARRAY
	HRRZ TT,TTSAR(TT)
	ADDI TT,<OBTSIZ+1>/2
	ROT A,-1
	ADD TT,A
	JUMPL TT,GCP8L5
	HRRZS (TT)
	JRST (T)
GCP8L5:	HLLZS (TT)
	JRST (T)

TWAP:	HLRZ A,(A)
	JUMPE A,(T)		;NIL IS ALREADY MARKED
	HLRZ TT,(A)
	TRZE TT,1
	JRST (T)		;NO SKIP IF ALREADY MARKED
	MOVE B,(TT)
	MOVE TT,1(TT)
	TLNN B,300		;SKIP 1 OF SYMBOL HAS SOME NON-TRIVIAL
	TLZE TT,-1		;PROPERTIES, E.G., ARGS OR COMPILED CODE REFERENCE
	JRST 1(T)
	HRRZ B,(B)
	HRRZ A,(A)
	CAIN B,QUNBOUND
	JUMPE A,2(T)		;SKIP 2 IF TRULY WORTHLESS SYMBOL, I.E., UNBOUND AND NO PROPERITES
	JRST 1(T)		;SKIP 1 IF MEANINGFUL PROPERTIES OR VALUE

;;; PRINT MESSAGE OF FORM "NNN[MM%] " FOR GC STATISTICS OUTPUT

STGPNT:	PUSH FXP,T	;RECLAIMED AMNT IN T, TOTAL FOR SPACE IN TT
	IMULI T,100.
	IDIVM T,TT
	EXCH TT,(FXP)
Q%	MOVEI R,TYO
Q$	HRRZ AR1,VMSGFILES
Q$	TLO AR1,200000
Q$	MOVEI R,$TYO
IFE USELESS,	MOVE C,@VBASE	;BASE HAD DAMNED WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN		;SKIPS
]		;END OF IFN USELESS
	   PUSHJ P,PRINI2
	STRT 17,[SIXBIT \[!\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,TT
IFE USELESS,	MOVEI C,10.
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,[10.]
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI3	;EFFECTIVELY, PRINI2 WITH *NOPOINT=T
	STRT 17,[SIXBIT \%] !\]	;BEWARE THESE BRACKETS!!!!!
	POPJ P,


;;; VERY IMPORTANT TABLE OF WORDS WITH SINGLE BITS!!! USED FOR MARKING!!!
GCBT:	REPEAT 36., SETZ←-.RPCNT

IFE D10,[

SUBTTL	RETURN CORE TO TIMESHARING SYSTEM

;;; HAIRY ROUTINE TO DECIDE WHETHER TO RETURN SOME BPS TO THE SYSTEM.
;;; MAY ONLY BE CALLED WHEN NOQUIT SPECIFIES NO INTERRUPTS.

RETSP:	MOVEI TT,4	;GTSPC1 IS ALLOWED TO GRAB 4 PAGES
	MOVEM TT,ARPGCT	; BEFORE INVOKING GC FOR LACK OF CORE
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	MOVE TT,BPSH
	LSH TT,-PAGLOG	;CURRENT HIGHEST CORE BLOCK IN BPS
	MOVE R,@VBPORG
	ADDI R,1(D)
	LSH R,-PAGLOG	;CORE NEEDED IF ARRAYS WERE PACKED
	CAML R,TT
	POPJ P,
	LSH R,PAGLOG
	ADDI R,PAGSIZ-1
	HRLM R,RTSP1	;NEW BPSH
	SUB R,D
	HRRM R,RTSP3	;NEW BPEND.
	JUMPE D,RTSP5
	HRLM D,RTSP3	;NO. OF CELLS TO MOVE.
	PUSHJ P,GRELAR	;(LEAVES BPEND-AFTER-RELOCATION IN TT.)
	HRL AR1,TT
	HRR AR1,RTSP3	;BLOCK PTR.
	SUBI TT,(AR1)
	JUMPLE TT,RTSP2
	MOVNI TT,1(TT)
	HRRM TT,RTSP1
	ADD AR1,R70+1
	HLRZ C,RTSP3
	ADD C,RTSP3
	BLT AR1,(C)
	MOVEI AR1,RTSPC1
	PUSHJ P,GSGEN	;DO PATCH-UP ON ARRAY PARAMETERS
	JSP T,RSXST	;????
RTSP2:	HLRZ TT,RTSP1
	MOVE R,TT
	EXCH R,BPSH
	HRRZ D,RTSP3
	MOVEM D,@VBPEND
IFE D10,[
	LSH R,-PAGLOG	;OLD CORE HIGHEST
	LSH TT,-PAGLOG	;NEW CORE HIGHEST
	SUBI R,(TT)
	MOVEI F,1(TT)
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI D,1(TT)
	LSH D,-SEGLOG+PAGLOG
	MOVE T,[$NXM,,QRANDOM]
	SETZ AR1,
	LSH TT,11
RTSP7:	ADDI TT,1000
	.CBLK TT,
	POPJ P,
	TLNN F,730000
	TLZ F,770000
	IDPB AR1,F
REPEAT SGS%PG,	MOVEM T,ST+.RPCNT(D)
	ADDI D,SGS%PG
	SOJG R,RTSP7
]		;END OF IFE D10
10$	CORE TT,
10$	LERR [SIXBIT \CORE?!\]
	POPJ P,

RTSP5:	SETZM GCMKL	;NO ARRAYS ALIVE
	MOVE TT,R
	PUSHJ P,BPNDST	;SETQ UP BPEND
	JRST RTSP2

RTSPC1:	JUMPE A,GGEN2
	HRRE B,RTSP1	;-(SIZE OF SHIFT + 1).
	JSP AR1,GT3D
	JRST GGEN2

]		;END OF IFE D10

SUBTTL	GET SPACE FROM TIMESHARING SYSTEM

GTSPC1:	HLLOS NOQUIT
	JSP R,GFSPC		;SEE IF FREE SPACE ABOVE BPEND WILL ADD ENOUGH
	SKIPLE AR1,ARPGCT
	JRST GTSP1B
	PUSHJ P,BPSGC		;WHEN COMPACTIFIED AND RELOCATED
	JSP R,GFSPC		;IF NOT, GC AND TRY AGAIN
GTSP1B:
IFE D10,[
	CAML D,HINXM
	JRST GTSP5A
	MOVEI T,(D)
	TRO T,PAGSIZ-1
	MOVE R,BPSH
	LSH D,-PAGLOG
	LSH R,-PAGLOG
	SUB D,R
	MOVN F,D
	ADDM F,ARPGCT
	MOVEI F,1(R)
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI TT,1(R)
	LSH TT,-SEGLOG+PAGLOG
	MOVE A,[$XM,,QRANDOM]
	PUSH FXP,AR1
	HLRZ AR1,(P)		;BEWARE! LH OF CALLING PDL SLOT = -1
	TRNN AR1,1		; MEANS THE GETSP FUNCTION IS CALLING
	TROA AR1,3
	MOVEI AR1,1
	LSH R,11
	IOR R,[004400,,400000]
GTSPC2:	ADDI R,1000
	.CBLK R,
;	JRST GTSP5		;FAILURE GIVES OUT NIL IN A, 0 IN TT
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE - TELL DDT
	TLNN F,730000
	TLZ F,770000
	IDPB AR1,F
REPEAT SGS%PG,	MOVEM A,ST+.RPCNT(TT)
	ADDI TT,SGS%PG
	SOJG D,GTSPC2
	POP FXP,AR1
	MOVEM T,BPSH		;FALLS INTO GRELAR
]		;END OF IFE D10
IFN D10,[
	SETZB A,TT		;GIVE OUT NIL AND 0 IF WE FAIL
	JRST CZECHI
]		;END OF IFN D10
GRELAR:	HLLOS NOQUIT	;MOBY DELAYED QUIT FEATURE.
	HRRZ A,BPSH	;LEAVE BPEND-AFTER-RELOCATION AS RESULT
	MOVEM A,GSBPN	;TEMPORARY BPEND
	MOVEI AR1,GTSPC3
	PUSHJ P,GSGEN	;RELOCATE ARRAYS
	JSP T,RSXST
GREL1:	MOVE TT,GSBPN
	PUSHJ P,BPNDST
	MOVE TT,(A)
CZECHI:	HLLZS NOQUIT
	JRST CHECKI	;CHECK FOR ↑G THEN POPJ P,

SUBTTL	ARRAY RELOCATOR

CNLAC:	MOVEI D,0		;COUNT NUMBER OF LIVING ARRAY CELLS, IN D
	MOVEI AR1,RTSPC2
	JRST GSGEN
BPNDST:	JSP T,FIX1A		;STORE NEW VALUE FOR BPEND
	MOVEM A,VBPEND
	POPJ P,

;;; COMES HERE FROM GRELAR VIA GSGEN.  AR2A HAS TAIL OF GCMKL, TT HAS TOTAL LENGTH OF ARRAY
GTSPC3:	JUMPE A,GT3G		;RELOCATE AN ARRAY
	MOVEI AR1,-1(TT)	;LENGTH-1 OF ARRAY IN AR1
	HLRZ A,(AR2A)
	HRRZ A,ASAR(A)
	SUBI A,1		;ARRAY AOBJN PTR LOC IN A.
	MOVE C,GSBPN
	SUBI C,(AR1)
	MOVEM C,GSBPN	;LOC NEW BPTR IN C
	MOVEI B,(C)
	SUBI B,1(A)	;RELOCATION AMOUNT-1 IN B
	CAML A,C	;IS ARRAY ALREADY IN PLACE?
	 JRST GT3C	;YES, SO EXIT
	SUBI C,(AR1)
	CAMGE A,C	;BEWARE: C COULD GO NEGATIVE!
	 JRST GT3A	;GOOD, EASY BLT
	ADDI C,(AR1)
	ADDI AR1,1(A)	;FIRST DESTINATION LOC
GT3B:	HRRZI C,(AR1)
	SUBI AR1,1(B)	;CONSTRUCT SOURCE ADDRESS
	HRLI C,(AR1)
	HRRZI T,(C)
	ADDI T,(B)
	BLT C,(T)	;SERIES OF SMALL BLTS
	CAMLE AR1,GSBPN
	 JRST GT3B
	ADDI AR1,(B)
	SUB AR1,GSBPN
	MOVE A,GSBPN
	SUBI A,1(B)
GT3A:	MOVE C,GSBPN
	ADDI AR1,(C)
	HRL C,A
	BLT C,(AR1)	;FINAL (OR ONLY) BLT
	JSP AR1,GT3D
GT3C:	SOS GSBPN
	JRST GGEN2

GT3D:	ADDI B,1
	HLRZ A,(AR2A)
	ADDM B,ASAR(A)	;UPDATE ARRAY POINTERS BY OFFSET IN B
	ADDM B,TTSAR(A)
	MOVE C,ASAR(A)
	ADDM B,-1(C)	;UPDATE AOBJN PTR BEFORE ARRAY HEADER
Q%	JRST (AR1)
IFN QIO,[
	HRR C,TTSAR(A)
	TLNE C,AS<FIL>
	 SKIPGE F.MODE(C)
	  JRST (AR1)
	MOVE C,TTSAR(A)
10%	ADDM B,AB.BP(C)		.SEE XB.AOB
10%	ADDM B,FB.IOT(C)
10$	ADDM B,FB.NBF(C)
	JRST (AR1)
]		;END OF IFN QIO

GT3G:	HRRZ AR2A,(AR2A)
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)	;CUT OUT DEAD BLOCK
	JRST GGEN1

	PGTOP GC,[GARBAGE COLLECTOR]

;;; ********** MEMORY MANAGEMENT, ETC **********

SUBTTL	PURCOPY FUNCTION

	PGBOT BIB

PURCOPY:	PUSHJ FXP,SAV5M2
	PUSH P,[RST5M2]
	PUSH FXP,CCPOPJ
	PUSHJ P,SAVX5
	PUSH P,[RSTX5]
	MOVEI TT,(A)	;USES A,B,T,TT
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,PUR
	 POPJ P,
   2DIF JRST (TT),PCOPY9,QLIST	.SEE STDISP

PCOPY9:	JRST PCOPLS		;LIST
	JRST PCOPFX		;FIXNUM
	JRST PCOPFL		;FLONUM
DB$	JRST PCOPDB		;DOUBLE
CX$	JRST PCOPCX		;COMPLEX
DX$	JRST PCOPDX		;DUPLEX
BG$	JRST PCOPBN		;BIGNUM
	JRST PCOPSY		;SYMBOL
REPEAT HNKLOG, JRST PCOPHN	;HUNKS
	POPJ P,			;RANDOM
	MOVSI TT,100		;ARRAY
IFN .-PCOPY9-NTYPES, WARN [WRONG LENGTH TABLE]
	IORM TT,(A)		;SET "COMPILED CODE NEEDS ME" BIT
	POPJ P,

PCOPLS:	HLRZ B,(A)		;PURCOPY A LIST ALREADY
	PUSH P,B
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	EXCH A,(P)
	PUSHJ P,PURCOPY
	POP P,B
PCONS:	AOSL TT,NPFFS		;PURE FS CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG		;NOTE: CLOBBERS TT
	ADD TT,EPFFS
   NOPRO
	HRLM A,(TT)
	HRRM B,(TT)
	MOVEI A,(TT)
	POPJ P,

PCOPFX:	MOVE TT,(A)
PFXCONS:	CAIGE TT,XHINUM	;PURE FIXNUM CONSER
	CAMGE TT,[-XLONUM]
	JRST PFXC1
	MOVEI A,IN0(TT)
	POPJ P,			;NOTE: EXITS WITH POPJ P,!!!
PFXC1:	AOSL A,NPFFX
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFX
   NOPRO
PFXC3:	MOVEM TT,(A)
	POPJ P,


PCOPFL:	MOVE TT,(A)
PFLCONS:	AOSL A,NPFFL	;PURE FLONUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFL
   NOPRO
	JRST PFXC3		;ALSO EXITS WITH POPJ P,!!!


IFN CXFLAG,[
PCOPCX:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PCXCONS:	AOSL A,NPFFC
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFC
	ADD A,EPFFC
   NOPRO
DB%	JRST PDBC3		;WILL DROP IN IF NO DOUBLES
]		;END OF IFN CXFLAG
IFN DBFLAG,[
PCOPDB:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PDBCONS:	AOSL A,NPFFD
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFD
	ADD A,EPFFD
   NOPRO
]		;END OF IFN DBFLAG
IFN DBFLAG+CXFLAG,[
PDBC3:
KA	MOVEM D,1(A)
KA	JRST PFXC3
KIKL	DMOVEM TT,(A)
KIKL	POPJ P,
]		;END OF IFN DBFLAG+CXFLAG


IFN DXFLAG,[
PCOPDX:
KA	REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVE R,(A)
KIKL	DMOVE TT,2(A)
PDXCONS:	AOSL A,NPFFZ
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,3(A)
	MOVEM T,NPFFZ
	ADD A,EPFFZ
   NOPRO
KA	REPEAT 4, MOVEM TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVEM R,(A)
KIKL	DMOVEM TT,2(A)
	POPJ P,
]		;END OF IFN DBFLAG

IFN BIGNUM,[
PCOPBN:	PUSH P,(A)
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	HLL A,(P)
	SUB P,R70+1
PBNCONS:	AOSL TT,NPFFB	;PURE BIGNUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD TT,EPFFB
   NOPRO
	MOVEM A,(TT)
	MOVEI A,(TT)
	POPJ P,
]		;END OF IFN BIGNUM

PCOPSY:	PUSH P,A
	HLRZ B,(A)
	MOVE TT,(B)
	TLNE TT,200
	JRST PCOPS1
	PUSH P,B
	HRRZ A,1(B)
	PUSHJ P,PURCOPY
	POP P,B
	HRRM A,1(B)
	MOVSI TT,100
	IORM TT,(B)
PCOPS1:	LOCKI
	JSP TT,ATMHSH
	IDIVI T,OBTSIZ
	PUSH FXP,TT
	MOVEI A,(FXP)
	MOVE T,VOBARRAY
	PUSHJ P,@ASAR(T)
	MOVEI B,(A)
	HRRZ A,(P)
	PUSHJ P,MEMQ
	POP FXP,D
	JUMPN A,PCOPS3
	MOVEI T,1		;GCPROTECT
	HRRZ A,(P)
	PUSHJ P,.GCPRO
PCOPS3:	UNLOCKI
	JRST POPAJ

IFN HNKLOG,[
PCOPHN:	SKIPN VHUNKP		;TREAT HUNKS AS LISTS IF HUNKP IS NIL
	 JRST PCOPLS
   2DIF [HRRZ B,(TT)]GCWORN,QLIST
	PUSH P,B		.SEE INTXCT	;CAN'T USE FXP
   2DIF [AOSL B,(TT)]NPFFS,QLIST
   2DIF [SKIPL (TT)]NPFFS,QLIST	;THIS WORD ALSO SERVES AS ARGUMENT TO GTNPSG!
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI D,-1(B)
	ADD D,(P)
   2DIF [MOVEM D,(TT)]NPFFS,QLIST
   NOPRO
   2DIF [ADD B,(TT)]EPFFS,QLIST	;B NOW HAS ADDRESS OF FRESH PURE HUNK
	PUSH P,A
	PUSH P,B
	MOVE D,(P)
PCOPH3:	ADD D,-1(P)		;WE SCAN THE OLD HUNK FROM THE END BACKWARDS
	HLRZ B,-1(D)		;GOBBLE A CAR AND A CDR
	HRRZ A,-1(D)
	PUSH P,B
	PUSHJ P,PURCOPY		;PURCOPY THE CDR
	EXCH A,(P)
	PUSHJ P,PURCOPY		;PURCOPY THE CAR
	HRLM A,(P)
	MOVE D,(P)		;CALCULATE PLACE IN NEW HUNK
	ADD D,-1(P)
	POP P,-1(D)		;POP COPIED CAR/CDR PAIR INTO PURE HUNK
	SOSE D,(P)
	 JRST PCOPH3
	SUB P,R70+3
	POPJ P,
]		;END OF IFN HNKLOG

IFN ITS,[

SUBTTL	GETCOR

;;; THIS ROUTINE IS SPECIFICALLY FOR PEOPLE WHO HAND-CODE LAP.
;;; IT IS USED TO ALLOCATE A NUMBER OF CONSECUTIVE PAGES
;;; OF MEMORY FOR VARIOUS PURPOSES, E.G. HACKING OF PDP-11'S
;;; OR INFERIOR JOBS OR WHATEVER.
;;; THE NUMBER OF PAGES DESIRED SHOULD BE IN TT; THE LOW ADDRESS
;;; OF THE PAGES IS RETURNED IN TT, OR ZERO FOR FAILURE.
;;; THIS ROUTINE DOES NOT ACTUALLY GET CORE; IT MERELY RESERVES
;;; ADDRESS SPACE.
;;; THERE IS CURRENTLY NO PROVISION FOR RETURNING THE MEMORY GRABBED.

GETCOR:	HLLOS NOQUIT
	LSH TT,PAGLOG
	MOVE T,HINXM
	SUBI T,(TT)
	CAMGE T,BPSH
	 JRST GTCOR6
	MOVEI F,(TT)		;GETTING F THIS WAY FLUSHES
	LSH F,-PAGLOG		; RANDOM BITS. (IT'S SAFER.)
GTCOR4:	JSP R,ALIMPG
	 .VALUE			;HOW CAN WE LOSE HERE?
	SOJG F,GTCOR4
	SKIPA TT,HINXM
GTCOR6:	 TDZA TT,TT		;LOSE, LOSE, LOSE
	  ADDI TT,1
	JRST CZECHI


IFN LHFLAG,[
LHVB0:	WTA [BAD SIZE - LH↑<!]
LHVBAR:	CAIL B,QLIST		;SUBR 2
	 CAILE B,QARRAY		;GROSS KLUDGE FOR LH
	  JRST LHVB1
	JSP T,FXNV1
	TLNE TT,-1
	 JRST LHVB0
	ADDI TT,PAGSIZ-1
	IDIVI TT,PAGSIZ
	MOVNI AR2A,(TT)
	PUSHJ P,GETCOR
	JUMPE TT,FIX1
	CAIE B,QARRAY
	 CAIN B,QRANDOM
	  XORI B,QARRAY#QRANDOM	;GROSS KLUDGE
	MOVEI D,(TT)
	LSH D,-SEGLOG
	IMULI AR2A,SGS%PG
	HRLI D,(AR2A)
   2DIF [MOVE R,(B)]GCWORS,QLIST
LHVB3:	MOVEM R,ST(D)
	SETZM GCST(D)
	TLNN R,$FS+BN+HNK
	 JRST LHVB4
	MOVE T,LHSGLK
	DPB T,[SEGBYT,,GCST(D)]
	HRRZM D,LHSGLK
LHVB4:	AOBJN D,LHVB3
	JRST FIX1

LHVB1:	EXCH A,B
	WTA [BAD SPACE - LH↑<!]
	EXCH A,B
	JRST LHVBAR
]		;END OF IFN LHFLAG

;;;	IFN ITS

SUBTTL	PDL OVERFLOW HANDLER


;PDLSTH:	0		;HACK ST FOR ADDING PDL PAGES
PDLST0:	MOVEI R,(D)		;USED BY PDLHAK TO EXTEND PDLS
	LSH R,11-PAGLOG		;D HAS BASE ADDRESS OF PAGE DESIRED
	IOR R,[4400,,400000]	;USES ONLY D AND R
	.CBLK R,		;CAUSE NEW PDL PAGE TO EXIST
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVEI R,(D)		;CALCULATE PURTBL BYTE POINTER
	ROT R,-PAGLOG-4
	ADDI R,(R)
	ROT R,-1
	TLC R,770000
	ADD R,[430200,,PURTBL]
	MOVEM P,FAKFXP		;SAVE P AT BOTTOM OF FAKE FXPDL
	MOVEI P,3
	DPB P,R			;UPDATE PURTBL
	LSH D,-SEGLOG			;HORRIBLE HACKERY TO UPDATE ST
	ADD D,[-SGS%PG-1,,ST-1]		; WITHOUT AN EXTRA AC:
Q% REPEAT SGS%PG, PUSH D,PDLST9-P(A)	; USE PUSHES! (CAN'T OVERFLOW)
Q$ REPEAT SGS%PG, PUSH D,PDLST9-P(F)	; USE PUSHES! (CAN'T OVERFLOW)
	MOVE P,FAKFXP
	JRST @PDLSTH


;;;	IFN ITS

IFE QIO,[

;PDLHAK:	0		;CALLED WHEN SOME PDL OVERFLOWS
PDLH0:	MOVEM D,QITD		;A=0 => CAUSED BY PUSH OR PUSHJ, ELSE
	MOVEM R,QITR		; UINT0 GIVES <# SLOTS NEEDED,,PDL AC>
	JUMPN A,PDLH0A		;SO JUMP IF WE KNOW WHICH ONE
	MOVEI A,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI A,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI A,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI A,FLP		;IF NOT FLP, THEN USER HAS LOST!
	JUMPL FLP,[LERR [SIXBIT \USER PDL OVERFLOW!\]]
;	JUMPGE FLP,PDLH0A
;IRP Z,,[P,FLP,FXP,SP]
;	MOVES (Z)		;CROCK DUE TO ITS LOSSAGE
;TERMIN
;	JRST PDLH3
PDLH0A:	HRRZ R,(A)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(A)		;IF WE'RE OVER THE ORIGIN OF THE
	JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,A
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(A)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	MOVE R,OC2-P(A)		; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(A)	;SKIP IF WE'RE ABOVE PDLMAX
	JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO A,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(A)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(A)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	SUBI D,20
	MOVEM D,ZPDL-P(A)
	HRRZ D,(A)
	JRST PDLH2A
PDLH2:	TLZE A,-1
	JRST PDLH2B
	CAMLE R,ZPDL-P(A)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	MOVE R,ZPDL-P(A)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(A)		;CLOBBER INTO PDL PTR
	HRRZ D,(A)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN A,-1		;SKIP IF WE WERE ABOVE PDLMAX
	JRST PDLH3
	HRLI A,QREGPDL-P(A)
	HRRI A,12.		;STACK UP USER INT 12. (PDL-OVERFLOW)
	HRRZ D,PDLHAK		;CAN STACK IT BECAUSE WE'RE IN UINT,
	CAIN D,PDLOV3+1		; WHICH WILL DO A CHECKI
	JRST PDLH4
	MOVE D,QITD		;RESTORE D AND R SO UISTAK
	MOVE R,QITR		; CAN SAVE THEM AGAIN
	JSR UISTAK
PDLH3:	SETZ A,
PDLH4:	MOVE D,QITD		;A NON-ZERO MEANS WE WANT TO RUN
	MOVE R,QITR		; A PDL-OVERFLOW INT
	JRST @PDLHAK

]		;END OF IFE QIO


;;;	IFN ITS

IFN QIO,[

;;; HAIRY PDL OVERFLOW HANDLER

PDLOV:	MOVE F,INTPDL
	MOVEM D,IPSWD2(F)	;SAVE D
	MOVEM R,IPSWD1(F)	;SAVE R
	SKIPL INTPDL
	 .VALUE			;I WANT TO SEE THIS! - GLS
	MOVEI F,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI F,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI F,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI F,FLP		;IF NOT FLP, THEN IT'S PRETTY RANDOM
	JUMPGE FLP,PDLH0A
	HLRZ R,NOQUIT
	JUMPN R,PDLH3A
	LERR [SIXBIT \RANDOM PDL OVERFLOW!\]

PDLH0A:	HRRZ R,(F)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(F)		;IF WE'RE OVER THE ORIGIN OF THE
	 JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,F
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(F)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	 MOVE R,OC2-P(F)	; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(F)	;SKIP IF WE'RE ABOVE PDLMAX
	 JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO F,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(F)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(F)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	 SUBI D,20
	MOVEM D,ZPDL-P(F)
	HRRZ D,(F)
	JRST PDLH2A

PDLH2:	TLZE F,-1
	 JRST PDLH2B
	CAMLE R,ZPDL-P(F)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	 MOVE R,ZPDL-P(F)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(F)		;CLOBBER INTO PDL PTR
	HRRZ D,(F)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	 JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN F,-1		;SKIP IF WE WERE ABOVE PDLMAX
	 JRST PDLH3A
	MOVSI D,QREGPDL-P(F)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLH3A:	HRRZ F,INTPDL
	JRST INTXIT+1


PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,IWAIT		; OVERFLOW HANDLER!!!
	 PUSHJ P,UINT
	HRRZ F,INTPDL		;RESTORE THE WORLD
	JRST INTXIT
	
]		;END OF IFN QIO


;;;	IFN ITS

IFE QIO,[
PDLOV:	.SUSET [.SIPIRQC,,A]
	SETZ A,		;MEANS WE DON'T KNOW WHICH PDL YET
PDLOV3:	JSR PDLHAK	;FIGURE IT OUT
	JUMPE A,INTEX1
	MOVEM A,CNTROL	;THIS IS A HACK
	MOVEI A,INTEX1
	EXCH A,CNTROL
	JRST UINT1R	;GO RUN PDL-OVERFLOW INTERRUPT
]		;END OF IFE QIO

MORPDL:	400		;AMOUNTS TO INCREMENT PDLS BY
	100		; WHEN OVERFLOW OCCURS (THIS GIVES
	LSWS+100	; LOSER A CHANCE TO SSTATUS PDLMAX,
	200		; AT LEAST)

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC

PDLST9:	$XM,,QRANDOM		;TYPICAL ST ENTRIES FOR PDL PAGES
	FL+$PDLNM,,QFLONUM
	FX+$PDLNM,,QFIXNUM
	$XM,,QRANDOM

PDLH5:	IORI R,PAGSIZ-1		;BAD PDL OV - REALLY DESPERATE
	SUBI D,-2(R)		;GIVE US AS MUCH PDL AS IS LEFT
	JUMPL D,PDLH6
	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
Q%	STRT @PDLMSG-P(A)
Q$	STRT @PDLMSG-P(F)
	JRST DIE

PDLH6:
Q%	HRLM D,(A)
Q$	HRLM D,(F)
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;FOO! HAPPENED IN GC - BOMB OUT!
Q%	HRRZ B,PDLMSG-P(A)
Q$	HRRZ B,PDLMSG-P(F)
	CAIE B,POVSPDL
	JRST PDLOV5		;PDLOV5 HANDLE WILL GET US TO TOP LEVEL
	MOVEM P,F		;FOR SP, TRY TO POP BINDINGS FIRST
	HRRZ TT,SPSV		; SO *RSET-TRAP WON'T OVERFLOW
	MOVE P,[-LFAKP-1,,FAKP]	;SO WE HAVE ENOUGH PDL FOR UBD
	PUSH P,FXP
	MOVE FXP,[-LFAKFXP-1,,FAKFXP]
	PUSHJ P,UBD
	POP P,FXP
	MOVE P,F
	JRST PDLOV5		;PDLOV5 WILL SET UP PDLS

]		;END OF IFN ITS

SUBTTL	PURE SEGMENT CONSER

;;; GTNPSG IS INVOKED AS FOLLOWS:
;;;		AOSL A,NPFF%	;SKIP UNLESS NO MORE LEFT
;;;	   SPECPRO INTPPC
;;;		PUSHJ P,GTNPSG	;MUST GET MORE
;;;		ADD A,EPFF%	;ELSE JUST FIGURE OUT ABSOLUTE ADDRESS
;;;	   NOPRO
;;; WHERE % IS SOME APPROPRIATE LETTER (E.G. S, X, L, B).
;;; GTNPSG UPDATES NPFF% AND EPFF% BY LOOKING AT THE AOSL, THEN
;;; RETURNS TO THE AOSL.

   XCTPRO
GTNPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
REPEAT 2,	SOS (P)		;BACK UP RETURN ADDRESS TO PRECEDING INST
	SAVEFX T TT D
GTNPS1:	MOVEI T,-SEGSIZ		;*NOT* "MOVNI T,SEGSIZ" !!!
	ADDB T,PSGAOB		;INCR'S LH BY 1, DECR'S RH BY SEGSIZ
	JUMPGE T,GTNPS3		;FOO! MUST GRAB A NEW PAGE!
	TLZ T,-1
	LSH T,-SEGLOG
IFE HNKLOG,	MOVE D,@(P)		;D POINTS TO NPFF-
IFN HNKLOG,[
	MOVE D,(P)		;THIS ALLOWS REFERENCE TO NPFF- TO BE INDEXED
	MOVEI D,@(D)		; BY TT, WHICH MUST BE SAFE TO THIS POINT
]		;END OF IFN HNKLOG
	SKIPN TT,GTNPS8-NPFFS(D)
	 .VALUE
	MOVEM TT,ST(T)
	SETZM GCST(T)
	LSH T,SEGLOG
	ADDI T,SEGSIZ
	MOVEM T,EPFFS-NPFFS(D)	;UPDATE PARAMETERS FOR NEW PURE SEGMENT
	MOVNI T,SEGSIZ+1
	MOVEM T,(D)
	MOVEI T,SEGSIZ
	ADDM T,PFSSIZ-NPFFS(D)	;UPDATE STORAGE SIZE
	RSTRFX D TT T
	JRST CZECHI

;;; TYPICAL ST ENTRIES FOR PURE SEGMENTS
GTNPS8:	LS+$FS+PUR,,QLIST		;LIST
	FX+PUR,,QFIXNUM			;FIXNUM
	FL+PUR,,QFLONUM			;FLONUM
DB$	DB+PUR,,QDOUBLE			;DOUBLE
CX$	CX+PUR,,QCOMPLEX		;COMPLEX
DX$	DX+PUR,,QDUPLEX			;DUPLEX
BG$	BN+PUR,,QBIGNUM			;BIGNUM
	0				;NO PURE SYMBOLS
REPEAT HNKLOG,	HNK+PUR,,QHUNK1+.RPCNT	;HUNKS
	0				;NO PURE SARS
IFN .-GTNPS8-NFF, WARN [GTNPS8 WRONG LENGTH TABLE]
	$XM+PUR,,QRANDOM		;SYMBOL BLOCKS


GTNPS3:
IFE D10,[
	MOVE T,HINXM		;FIGURE OUT IF ANY ROOM LEFT
	SUBI T,PAGSIZ
	CAMGE T,BPSH
]		;END OF IFE D10
IFN D10,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFN D10
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
IFE D10,[
	AOS TT,HINXM
	MOVEM T,HINXM		;UPDATE HINXM
	HRLI TT,-SGS%PG-1
	MOVEM TT,PSGAOB		;UPDATE AOBJN PTR
	MOVEI TT,1(T)
]		;END OF IFE D10
IFN D10,[
	MOVEM TT,HIXM
	HRLI TT,-SGS%PG-1
	MOVEM TT,PSGAOB
	AOS PSGAOB
	TLZ TT,-1
]		;END OF IFN D10
	LSH TT,-SEGLOG		;UPDATE ST AND GCST FOR NEW PAGE
	MOVE D,[$XM+PUR,,QRANDOM]
REPEAT SGS%PG, MOVEM D,ST+.RPCNT(TT)
REPEAT SGS%PG, SETZM GCST+.RPCNT(TT)
IFE D10,[
	MOVEI TT,1(T)		;UPDATE PURTBL
	ROT TT,-PAGLOG-4
	ADDI TT,(TT)
	ROT TT,-1
	TLC TT,770000
	ADD TT,[430200,,PURTBL]
	DPB T,TT		;T HAS 11 IN LOW TWO BITS
	MOVEI TT,1(T)		;MEANS CAN PURIFY IF WE THINK ABOUT IT
	LSH TT,11-PAGLOG
	IOR TT,[4400,,400000]
	.CBLK TT,
	 .LOSE 1000+%ENACR
]		;END OF IFE D10
IFN D10,[
	HRRZ TT,HIXM
	CORE TT,
	 .VALUE
]		;END OF IFN D10
	JRST GTNPS1


SUBTTL	FREE STORAGE SPACE EXPANSION

;;; THIS PORTION OF THE GARBAGE COLLECTOR DETERMINES WHETHER
;;; WE SHOULD JUST GRAB A NEW SEGMENT OF FREE STORAGE FOR SOME
;;; CONSER, OR DO A FULL-BLOWN GARBAGE COLLECTION. IT IS
;;; CONTROLLED BY PARAMETERS SETTABLE VIA (SSTATUS GCSIZE ...).

GCGRAB:	MOVN R,D
	JFFO R,.+1		;DETERMINE WHICH SPACE WANTED MORE
	SUBI F,NFF
	MOVEI AR2A,1		;MACRAK SEZ: GRAB JUST ONE
	SKIPN FFY2
	 SETZ F,
	JUMPE F,GCGRB1		; ... SEZ MACRAK
	MOVE D,SFSSIZ+NFF(F)
	CAML D,GFSSIZ+NFF(F)	;CAN'T JUST GRAB IF ABOVE SIZE
	 JRST AGC1Q		; SPECIFIED FOR "FREE GRABBIES"
	MOVE D,GFSSIZ+NFF(F)
	CAMLE D,XFFS+NFF(F)	;CAN'T GRAB IF IT WOULD PUT
	 JRST AGC1Q		; US ABOVE THE MAXIMUM SIZE
GCGRB1:	PUSH FXP,AR2A
	PUSHJ P,GRABWORRY
	POP FXP,AR1
	JUMPGE AR2A,AGC1Q	;GO DO FULL-BLOWN GC AFTER ALL
IFN WHL,[
	MOVE D,[-3,,GCWHL6]
	MOVE R,GCWHO
	TRNE R,1
	 .SUSET D
]		;END OF IFN WHL
	JRST GCEND

;;; THIS ROUTINE WORRIES ABOUT GETTING A NEW IMPURE FREE STORAGE
;;; SEGMENT. (FOR PURE FREE STORAGE SEGMENTS, SEE GTNPSG.)
;;; MUST DO SPECIAL HACKERY FOR SYMBOL AND SAR SPACES, SINCE THEY
;;; REQUIRE MORE THAN ONE CONSECUTIVE SEGMENT. PRINTS OUT PRETTY
;;; MESSAGES IF GCGAG IS NON-NIL.
;;; MUST HAVE NOQUIT NON-ZERO AND ST/GCST PAGES IMPURE WHEN ENTERING!

GCWORRY:	SUBI AR2A,(TT)	;ENTRY FOR GARBAGE COLLECTOR
	ADDI AR2A,SEGSIZ-1	;FIGURE OUT HOW MANY NEW SEGMENTS WE NEED
	LSH AR2A,-SEGLOG
GRABWORRY:
Q$	HRRZ AR1,VMSGFILES
Q$	TLO AR1,200000
	JUMPE F,.+2	;ENTRY FOR GCGRAB
	SKIPN GCGAGV		;MAYBE WE WANT A PRETTY MESSAGE?
	 SOJA AR2A,GCWOR2	;IF NOT, DECR AR2A (SEE BELOW)
	STRT 17,[SIXBIT \↑M;ADDING !\]
	SOJG AR2A,GCWR0A	;AR2A GETS DECR'ED HERE, TOO!
	STRT 17,[SIXBIT \A!\]	;KEEP THE ENGLISH GOOD
	JRST GCWR0B

GCWR0A:
Q%	MOVEI R,TYO
Q$	MOVEI R,$TYO
	MOVEI TT,1(AR2A)
Q$	PUSH FXP,AR2A
IFE USELESS,	MOVE C,@VBASE		;BASE DAMN WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
Q$	POP FXP,AR2A
GCWR0B:	STRT 17,[SIXBIT \ NEW !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SEGMENT!\]
	SKIPE AR2A
	 STRT 17,[SIXBIT \S!\]
GCWOR2:	SKIPE TT,IMSGLK
	 JRST GCWR2A		;JUMP IF ANY SEGMENTS AVAILABLE
	JSP R,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 JRST GCWOR7
GCWR2A:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,FSSGLK+NFF(F)	;CONS NEW SEGMENT ONTO LIST
	MOVEM TT,FSSGLK+NFF(F)	; OF SEGMENTS FOR THE
	HRRZ R,BTBAOB		; PARTICULAR SPACE
	HLL R,GCWORS+NFF(F)
	LSH D,22-<SEGLOG-5>
GCWR2B:	TLNE R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2C
	 IORI D,(R)		;MAYBE ALLOCATE A BIT BLOCK FOR
	IOR D,GCWORG+NFF(F)	; THE NEW SEGMENT FOR USE BY
	MOVEM D,GCST(TT)	; GC IN MARKING CELLS
	MOVE D,GCWORS+NFF(F)	;UPDATE ST ENTRY FOR THE
	MOVEM D,ST(TT)		; NEW SEGMENT
	MOVE D,FFS+NFF(F)	;ADD CELLS OF SEGMENT TO
	LSH TT,SEGLOG		; THE FREE STORAGE
	MOVEM D,(TT)		; LIST FOR THIS SPACE
	MOVE D,[GCWORX,,1]
	BLT D,LPROG9
	HLL TT,GCWORN+NFF(F)
	HRR GCWRX1,GCWORN+NFF(F)
	HRRI GCWRX2,-1(GCWRX1)
	JRST GCWRX1

GCWR2C:	HRRZM TT,FFS+NFF(F)
	TLNN R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2B
	 JRST GCWR4Q
	HRRZ TT,BTBAOB		;DECIDE WHETHER THIS BIT BLOCK
	LSH TT,SEGLOG-5		; LIES IN MAIN BIT BLOCK AREA
	MOVEI D,-1(TT)
	CAME D,MAINBITBLT
	 JRST GCWR3A
	ADDI D,BTBSIZ		;YES - JUST UPDATE MAIN BLT
	MOVEM D,MAINBITBLT	; POINTER FOR CLEARING 
	JRST GCWR3B		; BIT BLOCKS (SEE GCINBT)

GCWR3A:	LSH TT,-SEGLOG		;ELSE AOS COUNT OF BIT BLOCKS
	AOS GCST(TT)		; IN CURRENT BIT BLOCK SEGMENT
GCWR3B:	MOVE TT,BTBAOB		;AOBJN THE BIT BLOCK
	AOBJN TT,GCWOR4		; ALLOCATION POINTER
	SKIPE TT,IMSGLK		;FOO! OUT OF BIT BLOCKS!
	 JRST GCWR3F
	JSP R,ALIMPG		;FOO FOO! NEED NEW PAGE!
	 JRST GCWFOO
GCWR3F:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR LIST OF FREE SEGMENTS
	MOVE D,[$XM,,QRANDOM]	;UPDATE ST AND GCST FOR
	MOVEM D,ST(TT)		; NEW BIT BLOCK SEGMENT
	MOVEI D,(TT)		;GCST ENTRY IS USED TO
	LSH D,5			; INDICATE HOW MANY
	MOVEM D,GCST(TT)	; BLOCKS ARE IN USE
	MOVE D,BTSGLK		;CONS NEW SEGMENT ONTO LIST
	DPB D,[SEGBYT,,GCST(TT)]	; OF BIT BLOCK SEGMENTS
	MOVEM TT,BTSGLK
	LSH TT,5		;CALCULATE NEW BIT BLOCK
	HRLI TT,-SEGSIZ/BTBSIZ	; ALLOCATION POINTER
GCWOR4:	MOVEM TT,BTBAOB
GCWR4Q:	JUMPE F,GCWOR6
	MOVEI TT,SEGSIZ		;UPDATE VARIOUS GC PARAMETERS
	ADDM TT,NFFS+NFF(F)
	ADDB TT,SFSSIZ+NFF(F)
	CAMLE TT,XFFS+NFF(F)	;MUST STOP IF OVER MAX
	 SOJA AR2A,.+2		;KEEP COUNT ACCURATE
GCWOR6:	SOJGE AR2A,GCWOR2	;ALSO STOP IF WE GOT ALL WE WANT
GCWOR7:	JUMPE F,CPOPJ
	SKIPN GCGAGV		;MAYBE WANT MORE PRETTY MESSAGE
	 POPJ P,
	SKIPL AR2A
	 STRT 17,[SIXBIT \↑M; BUT DIDN'T SUCCEED!\]
	STRT 17,[SIXBIT \ -- !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SPACE NOW !\]
Q%	MOVEI R,TYO
IFN QIO,[
	MOVEI R,$TYO
	PUSH FXP,AR2A
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
]		;END OF IFN QIO
	MOVE TT,SFSSIZ+NFF(F)
IFE USELESS,	MOVE C,@VBASE
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	STRT 17,[SIXBIT \ WORDS!\]
Q$	POP FXP,AR2A
	POPJ P,

;;; TYPICAL GCST ENTRIES FOR IMPURE SPACES
GCWORG:	GCBMRK+GCBCDR+GCBCAR,,			;LIST
	GCBMRK,,				;FIXNUM
	GCBMRK,,				;FLONUM
DB$	GCBMRK,,				;DOUBLE
CX$	GCBMRK,,				;COMPLEX
DX$	GCBMRK,,				;DUPLEX
BG$	GCBMRK+GCBCDR,,				;BIGNUM
	GCBMRK+GCBSYM,,				;SYMBOL
REPEAT HNKLOG, GCBMRK+GCBCDR+GCBCAR+GCBHNK,,	;HUNKS
	GCBMRK+GCBSAR,,				;SAR
IFN .-GCWORG-NFF, WARN [WRONG LENGTH TABLE]
	0					;SYMBOL BLOCKS

;;; TYPICAL ST ENTRIES FOR IMPURE SPACES
GCWORS:	LS+$FS,,QLIST				;LISP
	FX,,QFIXNUM				;FIXNUM
	FL,,QFLONUM				;FLONUM
DB$	DB,,QDOUBLE				;DOUBLE
CX$	CX,,QCOMPLEX				;COMPLEX
DX$	DX,,QDUPLEX				;DUPLEX
BG$	BN,,QBIGNUM				;BIGNUM
	SY,,QSYMBOL				;SYMBOL
REPEAT HNKLOG, LS+HNK,,QHUNK1+.RPCNT		;HUNKS
	SA+$XM,,QARRAY				;SAR
IFN .-GCWORS-NFF, WARN [WRONG LENGTH TABLE]
	$XM,,QRANDOM				;SYMBOL BLOCKS

GCWFOO:	STRT [SIXBIT \↑M;GLEEP#! OUT OF BIT BLOCKS!\]
	JRST GCWOR7

GCWORX:			;EXTEND FREELIST THROUGH NEW SEGMENT
OFFSET 1-.
GCWRX1:	HRRZM TT,.(TT)	;OCCUPIES A,B,C,AR1 - MUST SAVE AR2A
GCWRX2:	ADDI TT,.
	AOBJN TT,GCWRX1
	JRST GCWR2C
LPROG9==:.-1
OFFSET 0
.HKILL GCWRX1 GCWRX2

GCWORN:	-SEGSIZ+1,,1				;LIST
	-SEGSIZ+1,,1				;FIXNUM
	-SEGSIZ+1,,1				;FLONUM
DB$	-SEGSIZ/2+1,,2				;DOUBLE
CX$	-SEGSIZ/2+1,,2				;COMPLEX
DX$	-SEGSIZ/2+1,,4				;DUPLEX
BG$	-SEGSIZ+1,,1				;BIGNUM
	-SEGSIZ+1,,1				;SYMBOL
REPEAT HNKLOG, -SEGSIZ/<2←.RPCNT>+1,,2←.RPCNT	;HUNKS
	-SEGSIZ/2+1,,2				;ARRAY SARS
IFN .-GCWORN-NFF, WARN [WRONG LENGTH TABLE]
	-SEGSIZ/2+1,,2				;SYMBOL BLOCKS


SUBTTL	IMPURE PAGE GOBBLER

;;; ALLOCATE AN IMPURE PAGE FREE STORAGE USE

ALIMPG:
IFE D10,[
	MOVE TT,HINXM		;MUST SAVE AR2A AND F FOR GCWORRY
	SUBI TT,PAGSIZ
	CAMGE TT,BPSH
]		;END OF IFE D10
IFN D10,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFN D10
	 JRST (R)		;NO PAGES LEFT - RETURN WITHOUT SKIP
IFE D10,[
	MOVEM TT,HINXM		;ELSE UPDATE HINXM
	MOVEI TT,1(TT)
	LSH TT,11-PAGLOG
	IOR TT,[4400,,400000]
	.CBLK TT,		;SO GET THE NEW PAGE OF CORE
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVE TT,HINXM
	MOVEI D,1(TT)		;COMPUTE A MAGIC BYTE POINTER
	LSH D,-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[430200,,PURTBL]
	MOVEI C,1
	DPB C,D			;UPDATE THE PURTBL
	TLZ R,-1
	CAIN R,GTCOR4+1		;DON'T HACK IMSGLK FOR GETCOR
	 JRST 1(R)
]		;END OF IFE D10
IFN D10,[
	MOVEM TT,HIXM
	CORE TT,
	 .VALUE
	MOVE TT,HIXM
]		;END OF IFN D10
	LSH TT,-SEGLOG
10%	ADDI TT,SGS%PG
	MOVE C,IMSGLK		;UPDATE ST AND GCST, AND ADD
	MOVE AR1,[$XM,,QRANDOM]	; NEW SEGMENTS TO IMSGLK LIST
	MOVEI D,SGS%PG
ALIMP3:	MOVEM AR1,ST(TT)
	SETZM GCST(TT)
	DPB C,[SEGBYT,,GCST(TT)]
	MOVEI C,(TT)
	SOJE D,ALIMP4
	SOJA TT,ALIMP3
ALIMP4:	MOVEM TT,IMSGLK		;WINNING RETURN SKIPS
	JRST 1(R)		;EXITS WITH LOWEST NEW SEGMENT # IN TT

SUBTTL	RECLAIM FUNCTION

IFN BIGNUM+USELESS,[

RECLAIM:	HRRZS A		;SUBR 2
	JUMPE A,CPOPJ		;GC A PARTICULAR SEXP
	LOCKI
	PUSHJ P,RECL1
	MOVEI A,NIL
	UNLKPOPJ


RECL1:	SKOTT A,LS+PUR
    2DIF JRST (TT),RECL9-1,QLIST	.SEE STDISP
	TLNE TT,HNK+VC+PUR	;DON'T RECLAIM VALUE CELLS!!! (OR HUNKS)
	 POPJ P,			; - ALSO DON'T RECLAIM PURE WORDS
	PUSH P,A		;SAVE ARG
	JUMPE B,RECL2		;B=NIL => RECLAIM ONLY TOP LEVEL OF LIST
	HLRZ A,(A)		;RECLAIM CAR
	PUSHJ P,RECL1
RECL2:	MOVE T,FFS
	POP P,FFS
	EXCH T,@FFS		;RECLAIM ONE CELL
	MOVEI A,(T)		;AND THEN GO AFTER THE CDR
	JRST RECL1

RECLFW:	JUMPE B,RECL9A		;B=NIL => DON'T RECLAIM FULLWORDS
	TLNE TT,$PDLNM		;DON'T RECLAIM PDL LOCATIONS!!!
	 POPJ P,
   2DIF [MOVE T,(TT)]FFS-QLIST	;RECLAIM NUMBER
	MOVEM T,(A)
   2DIF [MOVEM A,(TT)]FFS-QLIST
	POPJ P,

IFN BIGNUM,[
REBIG:	MOVE T,FFB		;RECLAIM BIGNUM HEADER
	EXCH T,(A)
	MOVEM A,FFB
	MOVEI A,(T)		;RECLAIM CDR OF BIGNUM
	JRST RECL1
]		;END OF IFN BIGNUM

RECL9:	JRST RECLFW	;FIXNUM
	JRST RECLFW	;FLONUM
DB$	JRST RECLFW	;DOUBLE
CX$	JRST RECLFW	;COMPLEX
DX$	JRST RECLFW	;DUPLEX
BG$	JRST REBIG	;BIGNUM
RECL9A:	POPJ P,		;SYMBOL
REPEAT HNKLOG, .VALUE	;HUNKS
	POPJ P,		;RANDOM
	POPJ P,		;ARRAY
IFN .-RECL9-NTYPES+1, WARN [WRONG LENGTH TABLE]

]		;END OF IFN BIGNUM+USELESS


IFN ITS,[

SUBTTL	VALUE CELL AND SYMBOL BLOCK HACKERY

;;; ROUTINE TO GET MORE VALUE CELL SPACE.
;;; EXPANDS VALUE CELL SPACE BY GETTING NEXT PAGE IN THE HOLE
;;; LEFT FOR THIS PURPOSE, AND EXTENDING THE VALUE CELL FREELIST.
;;; IF NO PAGES LEFT IN THE HOLE, A LIST CELL IS USED.

   XCTPRO
MAKVC3:	HLLOS NOQUIT
   NOPRO
	SOSL NFVCP
	JRST MAKVC4
	PUSHJ P,CZECHI
	PUSHJ P,CONS1
	SETOM ETVCFLSP
	JRST MAKVC1

MAKVC4:	MOVE A,EFVCS
	LSH A,11-PAGLOG
	IOR A,[4400,,400000]
	.CBLK A,		;SO GET THE NEW PAGE IN OUR CORE MAP
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVE A,EFVCS
	MOVEM A,FFVC
	LSH A,-SEGLOG
	MOVE TT,[LS+VC,,QLIST]
REPEAT SGS%PG, MOVEM TT,ST+.RPCNT(A)
	MOVSI TT,GCBMRK+GCBVC
REPEAT SGS%PG, MOVEM TT,GCST+.RPCNT(A)
	LSH A,-PAGLOG+SEGLOG	;UPDATE PURTBL
	ROT A,-4
	ADDI A,(A)
	ROT A,-1
	TLC A,770000
	ADD A,[430200,,PURTBL]
	MOVEI TT,1
	DPB TT,A
	AOS TT,EFVCS
	HRLI TT,-PAGSIZ+1
	HRRZM TT,-1(TT)
	AOBJN TT,.-1
	HRRZM TT,EFVCS
MAKVC8:	PUSHJ P,CZECHI
	JRST MAKVC0

]		;END OF IFN ITS


;;; SYMBOL BLOCK COPYING ROUTINE - TRIGGERED BY PURE PAGE TRAP, OR EXPLICIT CHECK
;;;	B POINTS TO OLD SYMBOL BLOCK
;;;	LEAVES POINTER TO NEW SYMBOL BLOCK IN B
;;;	CLOBBERS TT, LEAVES POINTER TO VALUE CELL IN A

LDPRG9:	TLCA B,LDPARG		;FASLOAD CLOBBERING ARGS PROP
ARGCL7:	TLC B,ARGCL3		;ARGS CLOBBERING ARGS PROP
	HRRZ A,(B)
	JRST MAKVC6

MAKVC9:	TLCA B,MAKVCX		;MAKVC CLOBBERING IN VALUE CELL
MAKVC5:	PUSHJ P,AGC
   BAKPRO
MAKVC6:	SKIPN FFY2		;COME HERE IF HRRM ABOVE CAUSES
	JRST MAKVC5		; A PURE PAGE TRAP - MUST COPY
	MOVE TT,@FFY2		; SYMBOL BLOCK FOR THAT SYMBOL
   XCTPRO
	EXCH TT,FFY2
   NOPRO
	HRLI A,777100		;ASSUME COMPILED CODE NEEDS IT
	MOVEM A,(TT)		; (THINK ABOUT THIS SOME MORE)
	MOVE A,1(B)
	MOVEM A,1(TT)
	HRRZ A,(TT)
	HRLM TT,@(P)
	EXCH TT,B
	HLRZ TT,TT
	JRST (TT)



SUBTTL	ALLOC FUNCTION

$ALLOC:	CAIE A,TRUTH		;SUBR 1 - DYNAMIC ALLOC
	 JRST $ALLC5
	SETO F,			;ARG=T => MAKE UP LIST
	EXCH F,INHIBIT		;CROCKISH LOCKI - DOESN'T MUNG FXP
	MOVNI R,NFF
$ALLC6:	PUSH FXP,GFSSIZ+NFF(R)	;SAVE UP VALUABLE DATA
	PUSH FXP,XFFS+NFF(R)	;LOCKI KEEPS IT CONSISTENT
	PUSH FXP,MFFS+NFF(R)
	AOJL R,$ALLC6
10% REPEAT 4,	PUSH FXP,XPDL+.RPCNT
	MOVEM F,INHIBIT		;EQUALLY CROCKISH UNLOCKI
	PUSHJ P,CHECKI
	PUSH P,R70
IFN ITS,[
	MOVEI R,4
$ALLC9:	POP FXP,TT
	SUB TT,C2-1(R)
	TLZ TT,-1
	JSP T,FIX1A
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QREGPDL-1(R)
	PUSHJ P,XCONS
	MOVEM A,(P)
	SOJG R,$ALLC9
]		;END OF IFN ITS
	MOVEI R,NFF
$ALLC7:	SKIPN SFSSIZ-1(R)
	 JRST $ALLC8		;SPACE SIZE IS ZERO - IGNORE IT
	POP FXP,TT
	PUSHJ P,SSGP2A
	PUSHJ P,NCONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QLIST-1(R)
	CAIN B,QRANDOM
	MOVEI B,QARRAY
	PUSHJ P,XCONS
	MOVEM A,(P)
	JRST $ALLC4

$ALLC8:	SUB FXP,R70+3		;FLUSH GARBAGE
$ALLC4:	SOJG R,$ALLC7
	JRST POPAJ


$ALLC0:	HRRZ A,(AR2A)
$ALLC5:	JUMPE A,TRUE		;DECODE LIST OF PAIRS
	HLRZ B,(A)		;ARG IS LIST OF SAME FORM AS
	HRRZ AR2A,(A)		; A .LISP. (INIT) COMMENT
	HLRZ C,(AR2A)
	CAIL B,QREGPDL
	CAILE B,QSPECPDL
	JRST $ALLC3
	MOVEI D,1←-1		;SSPDLMAX
	PUSHJ P,SSGP3$
	JRST $ALLC0

$ALLC3:	JSP R,SFRET
	 JRST $ALLC0
	 JRST $ALLC0
	SETZ AR1,
	MOVEI F,(C)
	SKOTT C,LS
	 JRST $ALLC2
	HRRZ AR1,(C)
	HLRZ C,(C)
	HLRZ F,(AR1)
	SKIPE AR1
	 SKIPA AR1,(AR1)
	  SKIPA F,C
	   HLRZ AR1,(AR1)
$ALLC2:	MOVEI D,3←-1		;SSGCSIZE
	PUSHJ P,SSGP3$
	MOVEI C,(F)
	MOVEI D,5←-1		;SSGCMAX
	PUSHJ P,SSGP3$
	MOVEI C,(AR1)
	MOVEI D,7←-1		;SSGCMIN
	PUSHJ P,SSGP3$
	JRST $ALLC0


	PGTOP BIB,[MEMORY MANAGEMENT STUFF]